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Pretace 


Most computer languages appear fo have a field of use for which they are 
most appropriate. Forth is no exception and has become tne standard 
language of the International Astronomical Union and 1s used for the control 
of radio telescopes. Forth naturally finds its way into other control appli- 
cations such as process control, machine too] contro! and robotics. In addition 
it has been used in diverse applications such as video games, spreadshceis and 
the space shuttle aft flight deck simulator. A major advantage of Forth is that 
it. can be tailored to the application, rather than the converse. In essence, 
Forth provides us with the tools to do the job. 

Like the English language, Forth is extensible. What is meant by that? 
Suppose by way of example we invent a completely new item. we will there- 
fore need to call it something, say a ‘whatsit'. We can now define wha! we 
mean by a ‘whatsit’ in terms of other words that we already know. To find the 
meaning of these other existing words we can look them up in a dictionary, 
although this presupposes that we already know a minimal number of words. 
In principle this is what we do in Forth. 

There are many books on Forth which go to great pains to explain the mini- 
mum required word set and give a few examples of their use. However when 
it comes to progressing beyond this stage it depends very much on one's own 
ability. At this point if the programmer does not take to Forth naturally, as 
can happen whcn weaned on a more conventional procedural language, it is 
tempting to say, ‘Hmm, very interesting’ and then po back to onc’s familiar 
language. After all, compared with a level-2 BASIC, Forth lacks the comfort- 
able line numbers, floating point arithmetic, tngonometric functions, strings 
and arrays. But Forth is extensible. If the user finds it necessary the required 
features may be added in a form most suited tu the application. 

In this book some common extensions are presented, together with some 
programs that have been found either useful or entertaining. It 1s hoped that 
in so doing the methods will stimulate readers to see solutions to their own 
programminy problems. The extensions are commonplace and may be stand- 
ard in some Forths but lacking in others. Inevitably when seeking a missing 
definition in a hurry, one never seems able to find it readily when it ts most 
needed. Hopefully the ccllection in this book will fulfil that need. 

One of Forth's many vinues is that it is far more portable than languages 
such as BASIC, the latter having over 100 differing dialects. This portability ts 
achieved by first defining a virtual Forth computer for a given machine. This 
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simulated computer now looks the same for every computer so that the same 
Forth language will run on it. There are, however, vanants in the language 
and some word definitions can be in the native code of the machine in use and 
probably will not transfer directly to a different processor type. These Forth 
dialects are usually not too different but where a difference is known to exist, 
this has been noted in the text. Additionally most differences are between 
FigForth and the '79-standard and are listed in Chapter 1. At the time of writ- 
ing these two standards, although superseded, are still dominant in number. 
Variants considered are FigForth, '79-standard and ‘83-standard. Com- 
mercial variants such as MMS-Forth and PolyForth are not covered in this 
book because their comprehensive vendor support renders it unnecessary. 
Where CODE definitions are used, 6502 code is used with high-level Forth 
equivalents also included where applicable. Although machine-specific, this 
processor was chosen because it is used by Apple, Atari, Commodore and the 
BBC computers. 

Finally the author would like to express appreciation to all who have put so 
much effort into publicizing Forth and putting it to work on an ever increasing 
range of tasks. 


Ron Geere Farnborough 
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1 Getting Organized 


Mass storage is a key element in Forth and is sometimes referred to as ‘virtual 
memory’. This is a concept whereby the computer ts led to believe that it has 
more memory than it really has. It works by storing the program or data on a 
Mass storage device, such as a floppy disk drive, and transferring only part of 
the total storage available into the computer's memory space at any one time. 
Historically this came about so that Forth could be used on small micro- 
processor systems with limited memory capacity. Recent 16-bit machines have 
ample memory for Forth and versions exist which have dispensed with the 
virtual memory arrangement. At the other extreme some low cost systems 
dispense with disk storage in favour of cassette storage. Such systems are 
perhaps adequate for learning and experimentation, but cannot be considered 
for serious program development. 

A ‘bare bones’ disk-based Forth system will require some initial preparation 
of the disk itself. Starting off with a totally unused diskette, the first job will be 
(o format it with tracks and sectors. This is not specific to Forth, but a charac- 
teristic of ‘soft-sectored’ disk usage. To do this from Forth, you will need to 
refer to your user handbook. If your Forth is a ‘home brew’ system, you will 
have to home brew your own method of dong this also! 

The next step is to put the following Fig and °79-standard error messapes 
on screens 4 and 5 using the EDITOR. The text of line number 15 of screen 4 is 
printed at the foot of each page by TRIAD and is usually modified to contain a 
copyright message or some personal identification. 


SCR #4 

O ¢( ERROR MESSAGES ) 

EMPTY STACK 

DICTIONARY FULL 

HAS INCORRECT ADDRESS MODE 
ISN'T UNIQUE 


DISK RANGE ? 
FULL STACK 
DISK ERROR ! 


= ©} 0O wns OW & WAR — 


af — 
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to be inserted into the sequence. One way round this problem ts to keep the 
chained blocks to perhaps two or three related blocks and to call the head of 
each chain from a ‘load block’. 

The purpose of a load block is to call up and load all the blocks required for 
a specific application. It is convenient if the block/screen number used is 
numbered relative to the load block. To do this we define RLOAD (or perhaps 
+LOAD) which will load a block calculated from the number of the load block 
plus a signed offset on the stack. The definition is also arranged to print the 
header (line 0) of the block at the head of each chain, spaced for an 80- 
column VDU. 


- RLOAD ( N --- /Load scré¢N 2) 
BLK a2 + CR 8 SPACES O OVER .LINE 
CR 2 SPACES LOAD ; 


A hypothetical! load block might have some of the following information. 


3 RLOAD ( editor extensions ) 
8 RLOAD ( Forth extensions ) 
12 RLOAD ( 2 2/ etc. ) 
15 RLOAD ( double word set ) 
29 RLOAD ( trig functions ) 
45 RLOAD ( application constants ) 
57 RLOAD ( system input routines ) 
43 RLOAD ( data validation ) 
33 RLOAD ( output formatting ) 


You will see that each subsection is commented. It also makes life easier if the 
load block is at an easily remembered number — 10 LOAD is easier to remember 
than, say 19 LOAD. One could even go a step further and define a constant for 
each of several load screens using the application name for each as a label. As 
previously mentioned, the first screen line is displayed as each RLOAD is 
executed, so that when the application loads it might look like this: 


( editor extensions - 1 of 4 search replace ROG-820211 ) 
size ?isn't unique 
( extensions - 1 of 2. ascii $%xx ctrl-x RDG-830115 ) 
( code for 2s - 1 of 3 ae 2/ des RDG-820224 ) 
( double word set - 1 of 3 ROG-830507 ) 
( trig functions - 1 of 4 sin cos etc. RDG-830515 ) 
( constants - 1 of 1 ROG-830521 ) 
( system input - 1 of 2 ROG-830522 ) 
( data validation - 1 of 2 RDG-830630 ) 
( formatting - 1 of 3 ROG-830702 ) 


If the hard copy printer supports 132-column output it is useful to be able to 
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print two screens side by side. This is especially so if shadow blocks are being 
used since the description can be adjacent to the definition. Blocks can be 
listed in pairs by using PLIST defined in Chapter 10. 

A number of useful Forth words have been published which enhance the 
readability of a program: for example, how much more readable it 1s if one 
defines the words: 


> TRUE |) 3° 4 FALSE .@° ; 


or perhaps replaces 3 EMIT with CTRL-C EMIT or 42 EMIT with ASCII * EMIT - 
such words are a prerequisite in any sizeable application. 


- ASCII ( --- N /Leave ASCII value of next in-line char. *) 
BL WORD HERE 1+ Ca (CCOMPILE] LITERAL :; IMMEDIATE 


ASCII leaves on the stack the ASCII number equivalent of the following 
character |!]. When compiling, the next input-stream WORD delimited by BLank 
is placed at HERE and the first character fetched to the stack for use by LITERAL 
whose compilation is forced by [COMPILE]. A similar, shorter, but less readable 
word 1s &X where X = the character [2],[3]. In this case the parameter follow- 
ing is not passed via the stack but by way of the header with the WIDTH reduced 
to one. $XX simplifies hexadecimal notation since the base can remain 
unchanged and the sequence 8 16 32 64 may be better expressed as $08 $10 
$20 $40 in some instances. Likewise addresses are usually best expressed in 
hexadecimal as $EO00 for example, without perforating the text flow alter- 
nately with the words HEX and DECIMAL. HERE should be included only for 
FigForth. 


( &X SXX SXXXX CTRL-X ) 
32 CONSTANT & 1 WIOTH ' 
: &Y HERE 24 Ca CCOMPILE) LITERAL ; IMMEDIATE 


0 
1 
2 
3 
4 > $XX BASE a HEX 0 O HERE 1% (NUMBER) SWAP OROP ROT BASE ! 
5 
6 
7 
8 


Cd BL - O 7ERROR CCOMPILE) LITERAL ; IMMEDIATE 
© SXXXX 
C(COMPILE] $XX ; IMMEDIATE 
9 
10 5 WIOTH ! 
11 : CTRL-X 
12 HERE 6 + Ca 64 - CCOMPILE) LITERAL ; IMMEDIATE 
13) 31 WIDTH | 
14 
15 


In later standards (NUMBER) should be replaced by CONVERT. Additionally 
FigForth users may want to add definitions which are required in later stand- 
ards but which are lacking in FigForth, such as U. M+ followed by some of the 
extensions defined in later chapters. 
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1.3. DIFFERENCES BETWEEN FIGFORTH AND ’79-STANDARD FORTH 


Forth originated from the ideas of one man but as the Janguage has matured 
several standards have evolved. Unfortunately it is not practicable to give 
cross-conversion between any two of the major dialects. At the time of writ- 
ing, FigForth and the '79-standard are numerically the most popular and, 
therefore, if you are using Forth based on the early Forth Interest Group (Fig) 
standard you may have to make changes to a program wniten to the ‘79- 
standard. In general a simple conversion process is all that is involved, but 
some words such as DOES> behave differently and are perhaps best handled by 
an amendment to the program if necessary. 


SCR 4133 

0 ( '79 STANDARD CONVERSION TO FIGFORTH ) 
1 CODE J 

2 XSAVE STX, TSX, 

3 R46 ¢ LDA, PHA, R 5 * LDA, 

4 XSAVE LOX, PUSH JMP, 

5 

6 CODE Ra 

7 FORTH ‘ RCFA A ' Ra CFA ! 

8 

9 COOE EXIT 

10 " 3S CFA a ' EXIT CFA ! 

11 

12.2 

13 

14 

15 
SCR 4134 

0 ( '79 STANDARD CONVERSION TO FIGFORTH ) 


: MOVE ( ADI AD2.N --- ) 
2 (MOVE ; 


2 

3 

4 

5 : VARIABLE 
é QO VARIABLE ; 
7 

8 


: CREATE 
9 VARIABLE -2 ALLOT ; 
10 --> 
11 
12 
13 
14 
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SCR #135 

QO € '79 STANDARD --> FIGFORTH ? 
ie ap Od. ; 

2: > > = 

34 1- 1- + 

4 3 2- ¢é- 3 

5 : >IN IN : 

6 3 2DUP -DUP ; 

7 : CONVERT (NUMBER) ; 
8 : DNEGATE OMINUS ; 

9 : NEGATE MINUS ; 

10 S.N0T O- ; 

11. : SAVE-BUFFERS FLUSH : 

12 : U/MOD Ue, 

13: SIGN Q< IF 20 HOLD THEN ; 
14 : WORD WORD HERE ; 


15 + 79-STANDARD ; 


The '83-standard may present further problems with a different behaviour 
associated with important words such as CREATE, LEAVE, EXPECT, WORD, FIND, 
PICK and ROLL. As a result conversion to or from Forth-'83 is far more 
complicated. For further information you should refer to the appropriate 
Forth standards [4] or the articles by Berkey [5],(6]. Reference [7] explains 
the differences in some detail. 


‘All changes to a computer programming language degrade its quality’ 
— Professor A. Sale 


1.4 AVOIDING THE ASSEMBLER 


Sometimes it is necessary to produce a definition in the native code of the 
processor. To do this on a small system for perhaps only one definition is 
somewhat inefficient in memory usage, since the entire assembler must be 
loaded for just that one em. Alternatively, on a small system, there may not 
even be an assembler available! 

So how can we avoid using the memory space required by the assembler, 
yet include CODE definitions in our vocabulary? Suppose we want to use the 
word RVS to invert the video of a memory-mapped CRT screen. Using a 
typical assembler the word could be defined thus: 


CODE RVS ( --- /Invert 2K of video RAM starting at $8000 *) 

XSAVE STX, $08 STY, 884 LDA, O9 STA, 
BEGIN, 09 DEC, 

BEGIN, 08 )Y LDA, 80 4 EOR, O08 )Y STA, 

DEY, O: 

UNTIL, O9 LOX, 80 4 CPX, O= 
UNTIL, XSAVE LDX, 
NEXT JMP, END-CODE 
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This would compile into the dictionary a header containing the name RVS and 
a parameter field containing bytes corresponding to the assembled code. The 
same effect could be achieved by the following method: 


( UTILITY - RVS INVERTS SCREEN VIDEO RDG-830729 ) 
HEX 
CREATE RVS ( --- /Invert $8000 to S7FFF + ) 


0586 , 0884 , 88A9 , 0985 , 096 , 08B1 , 8049 , 0891 , 
88 C, F700 , 0946 , BOEO , EFDO , OSAG6 , 4C C, 0642, 
SMUDGE DECIMAL 


The word CREATE creates a dictionary hcader containing the name RVS. The 
succeeding numbers are then compiled into the dictionary and examination 
will reveal that they correspond to the same numbers that would be generated 
by the assembler. Obviously some manual conversion must be undertaken, 
especially with branch offsets, for this is what assemblers are intended to 
eliminate. One needs, therefore, a table of op-codes for the processor con- 
cerned (in this example the 652) and also the address of the word NEXT. 

{[f you are interested in using RVS you are probably aware that it was written 
for the Commodore 8032 which has 2K of video-mapped RAM from $8000 
to S&87FF and the routine uses an address pointer at $08/09. A word of 
caution: this definition ts even more unreadable than the version using the 
assembler. Do document how it works on the disk or you will waste a lot of 
time someday trying to fathom it all out. Even with a disassembler to convert 
back to assembly language, some additional notes will not go amiss. 

The definitions :CODE and ;NEXT make the creation of these hand assembled 
definitions neater and easier to read at a later date. 


0 ( WORDS IN LIEU OF ASSEMBLER ROG-841014 ) 
HEX 0642 CONSTANT NEXT-LINK ( the address of NEXT ) 


é 
3 
4 : :CODE ( --- N /CREATE HEADER WITH CFA 

5 POINTING TO BODY OF WORD *) 
6 BASE ad HEX CREATE ; 

? 

8 


‘ sNEXT ( N --- /Terminate body of word with jump to NEXT t) 

9 4C C, NEXT-LINK , SMUDGE BASE! ; 

10 DECIMAL 

11 

12 

13 

14 

15 


If you have the source listing of an assembler for your system, you may be able 
to find the address of NEXT from that. Alternatively, other related words may 
be required and to find them on a typical 65S02-based system you can try these 
assumptions and leave the address on the stack. 
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HEX ' LIT 11 # CONSTANT PUSH (push lo in A, hi in P) 
‘ LIT 13 4 CONSTANT PUT (drop top & PUSH) 
‘ LIT 18 + CONSTANT NEXT 
" EXECUTE NFA 11 - CONSTANT SETUP 
' (D0) OC + CONSTANT POPTWO (remove 2 items) 
' (00) O& + CONSTANT POP (remove 1 item) 


They are correct for FigForth, and the addresses are assumed to be fixed 
offsets from known landmarks in the dictionary kernel. However, should the 
source code differ in some respect from the FigForth source the assumption 
may not be valid. In addition, the FigForth word tuck (') which returns the 
parameter field address of the following word may need to be replaced by 
FIND. Since also in FigForth, FIND returns the code field address the figures 
will also need adjustment. 

It is a wise precaution before testing that the code definition operates as 
intended to first check the compiled code using DUMP. The most likely error 
with 6502 code is to have hi/lo byte pairs transposed or perhaps relative 
branch/offset values reversed. 

CREATE is a ’79-standard word and may not be in a FigForth implementa- 
tion; as an alternative to re-defining it (see SCR 134 in Section 1.3) CREATE can be 
replaced by: 


Q VARIABLE <name> -2 ALLOT 


Project 


Explore your dictionary to find the addresses for NEXT etc. Expand the 
pseudo-assembler to include ;PUSH ;PUT ;POP — can a defining word ENDING 
(created with CREATE... 00ES>) be used for this family of words? e.g. NEXT-LINK 
ENDING ;NEXT 
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2 Some Forth Extensions 


There are many definitions that ace commonplace but do not form part of the 
minimum required word set. In this section an assortment is presented that 
you may find useful. 


2.1 COUNTER-ROTATE ( -ROT OR <ROT ) 


This is often required after operating on the third stack item. ROT brings it to 
the top and ROT ROT reinstates it. One could define -ROT as ROT ROT, but this 
version ts more efficient. 


: -ROT ( N1 N2 N3 --- N3_N1 N2 /Counter-rotate top three e) 
SWAP >R SWAP RD > 


2.2 TUCK 


A combination of words that occurs frequently gives rise to the definition 
TUCK. This puts a copy of the top stack item under the top two. It could be 
considered as the converse of OVER, so perhaps it ought to be called UNDER? 


: TUCK ( N1 N2 --- N2 N1 N2 /Copy TOS under tap two ¢) 
SUAP OVER ; 


2.3 LOOKING AT THE STACKS 


DEPTH appears in some systems; if not, the following definition will return the 
number of items on the stack that were there before DEPTH was executed. Note 
that this definition is system dependent. The numbers 136 and 134 are related 
to the base address of the stack of a 6502 system. The 136 could be replaced 
by $0, the contents of user vanable SP0. Some implementations have $0 and/ 
or SPO missing, and even if it is available, the detail of its operation may vary 
across different Forth standards. Entenng 


SP! OEPTH 


should print 0; otherwise adjust these values until it does. 
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: DEPTH ( --- N /Leaves number of items on the stack 2) 
SPa 136 SWAP - 2/7 ; 


There are some Forth systems that use 'S instead of SPa@ to return the address 
to the top of the stack as it was before the address was added. 

To print out the stack contents non-destructively, the definition .S has 
proved itself useful. Again, it is system dependent: 


> 4S ( --- /Prints the stack contents t ) 
CR DEPTH IF SPa 2 - 134 DO 14a. -2 #LOOP 
ELSE ." Empty" THEN ; 


The Forth-’79 and subsequent standards prohibit access to Forth’s innards so 
that RPd which returns the current value of the return stack pointer is no 
longer part of the required word set. However, it is a useful word when de- 
veloping utilities which hook into Forth’s inner workings: 


CODE RPa XSAVE STX, TSX, TXA, XSAVE LOX, PHA, O1 # LDA, 
PUSH JMP, END-CODE 


which without the assembler is equivalent to: 


HEX 

CREATE RPd ( --- N /Returns address in return stack register *) 
0586 , BAC, 8A C, 05A6 , 48 C, OIAI , 
4C C, 0638 , ( PUSH ) SMUDGE DECIMAL 


PICK is not included in the required word set of FigForth, although extensive 
use of this word may imply that perhaps there are too many items on the stack 
for good Forth style. 


: PICK ( N1 --- N2 /Pick the Nith stack item & copy to tap” *) 
DUP + SPa+ a; 


Be careful of programs wnitten for the '83-standard where the value of N1 is 
zero-based. In Fig and °79-standards the top stack item is number one. An 
example of the use of PICK is in 3DU? which duplicates the top three stack 
items. 


: 3DUP (.N1.N2.N3 --- N1.N2 N3.N1 N2.N3 /DUPLicate top 3 4) 
3 PICK 3 PICK 3 PICK ; 


or alternatively: 
DUP 20VER ROT ; 


A further definition of 3DUP appears in DS@RT in Chapter 6. One should of 
course be less specific and define a more general purpose version called NDUP 
which replicates the top N stack items: 


: NDUP ( N --- /Replicate top N stack items a) 
1¢ DUP 1 DBO OUP PICK SWAP LOOP DROP ; 
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2.4 LOOP VARIABLES 


With the more recent microprocessors it is possible that DO...I-OOP para- 
meters have their own independent stack and the following system dependent 


definitions will need to be rewritten. They assume that the loop stack and the. 


return stack are the same. This is why the words I and R (or Ra) are not neces- 
sarily identical. 

The word I' is commonly used to retrieve the loop limit from within the 
loop. 

a) bo ( --- N) 

FORTH R> R> R -ROT ROR ; 

The top item on the return stack is the address of the next definition to be 
executed (usually, but not always) and the second item is the loop variable. 


R or Ra fetches a copy of the loop limit. -ROT puts this limit under the other 
two values which are then restored to the return stack. See Figure 2.1. 


Ps 


, Return 
' address I 
L an o= == a= d 
Normal Deferred 
nested loop 


laop 


Fipure 2.1 Loop parameters on the return stack. 


= 


An altermative use for I' is to obtain the loop variable from another defini- 
tion used within the loop. For example: 


: CTEST): CRT" BR: 
TEST 5 0 00 (TEST) LOOP ; 


J returns the value of the outer loop variable of a nested DO... LOOP: 


4 
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HEX 
CREATE J 0586, BAC, BOC, 0105 , 48 C, BDC, 0106 , 
0506 , 4C C, 0638 , ( PUSH ) SMUDGE DECIMAL 


which in assembler js: 


XSAVE STX, TSX, RP) 4 + LDA, PHA, 
RP) 5 + LDA,  XSAVE STX, PUSH JMP, 


This could be coded in high-level thus: 
fal R> R> R> R SWAP >R SWAP >R SWAP >R 3; ( --- N ) 


The high-level version respectively removes from the return stack the cfa 
arising from J itself, inner loop variable I, inner loop end limit and then copies 
the outer loop index. These are then in turn each SwWAPped and returned so 
that the stack may be correctly restored. Take care not to confuse R> and >R - 
the result would be catastrophic! 

BOUNDS will convert the count Nat the given address to start and end values 
ready fora DO...LOOP. 


> BOUNDS ( addr N --- addr+N addr /Make start & end values *) 
OVER ¢ SWAP ; 


2.5 RECURSIVE ROUTINES 


Recursion requires a route to call itself. In some computer languages this 
cannot be done, but Forth js not so constrained. Recursion makes demands on 
the rcturn stack and in extreme cases this could be a limitation. 

In Forth, the word currently being compiled is not ‘seen’ to be in the vocab- 
ulary until its definition is complete. Many of you will know that the purpose 
of the ‘smudge bit’ 1s to identify this situation. The problem is to compile the 
cfa of a word which has yet to be SMUDGEd. Fortunately the solution is simple 
because LATEST returns the name field address (nfa) of the latest definition 
without reference to the smudge bit. To convert this address to the compila- 
tion or code field address (cfa) we must first convert the nfa to a parameter 
field address (pfa) and this in turn to the cfa which is subsequently compiled. 
Finally the definition is made IMMEDIATE so that it acts during the compilation 
process. 


- MYSELF ( --- /Calls current definition from within itself +) 
LATEST PFA CFA , » IMMEDIATE 


Sometimes this word is named RECURSE. As an example of its use, here is a 
recursive definition of ROLL [1]. 


: ROLL ( Rotate the top N stack items * ) 
DUP 2 < IF DROP 


ELSE SWAP >R 1 - MYSELF R> SWAP 
THEN 


« 
é 
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The definition of ROLL sets out to climinate the trivial case where N= 1 or less. 
It then moves in turn each former stack item to the return stack and decre- 
ments N by one each time. The process is repeated by calling itself (remember 
MYSELF compiles the cfa of ROLL) until the conditional becomes true (N < 2) 
and MYSELF is no longer catled. The expression following MYSELF restores each 
stack item, but SWAP the Nth item to the top until the return stack is restored. 

The same comments apply to ROLL as to PICK regarding the stack parameter, 
but then an ‘83-standard implementation should already have hoth PICK and 
ROLL. 


2.6 MEMORY USAGE 
To determine the amount of available memory use: 


: FREE ( --- /Return bytes free in dictionary *) 
FIRST HERE -. ." BYTES" CR ; 


since this is simply the difference between the first disk buffer and the current 
top of the dictionary. However it is dependent on the layout of the Forth 
model for the system in use and takes no account of space occupied by ?AD for 
example. 


2.7 TESTING PARAMETERS 


While Forth's do-it-yourself nature can be one of tts virtues, it can lead to a 
proliferation of variations on the same theme. The definition of WITHIN in 
various guises has appeared from time to time [2] and is used to test that a 
parameter lies WITHIN a specified range. The input stack parameter sequence 
may be different, and the limits may be equal or exclusive to the value of N. Of 
course the polarity of the output flag could also differ! The example shown 
was chosen for its brevity. It is not the most efficient because most of the 
coding is hidden within the words MIN and MAX. 


: WITHIN ( lo hi N --- € /True flag if Nis = or within lo-hi *) 
DUP >R PIN MAX RD = > 


a 


My personal preference is for TWIXT which leaves a true flag if fo <N < hi. 


: TWIXT (N lo hi --- f /flaqg is true if Nis twixt lo& hi #) 
3 PICK < OQO= -ROT < O- AND ; 


On occasions it is necessary to constrain a value to within certain limits. 
LIMITS is neat and simple, most of its work being hidden inside MIN and MAX. 
An alternative name would be CONFINE. 


: LIMITS ( N1 lo hi --- N2 /N2 is N1 Limited to lo & hi *) 
ROT MIN MAX ; 


Similar to LIMITS is <MOD> except that a wrap around effect occurs as with M00, 
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although the behaviour is different. The table illustrates the action of <M00> for 
N2 = 5S: 


6 7 8 
cot 2 J ete: 
A Itkely use for such action is to increment or decrement the index to an array 
or table with wrap around. Indev nosition zero in each of several such tables 
contains the modulus N2. <M00> then constrains N1 to the index limits of that 


table. 


: <M00> ( N1 N2 --- N3 /limits N1 to range 1 - N2 as value N3 ¢) 
SWAP 1 - OVER MOD DUP O< 
IF + ELSE SWAP DROP THEN 1¢ ; 


2.8 ROUNDING 


Frrors often occur as a result of integer division where the effect is to truncate 
the fractional part. The error may be reduced by scaling the numerator by 10 
if possible and applying ROUND to the result. The effect 1s to round up 175 to 
180 and round down 174 to 170. The scaling factor may he removed later. 
Notice that with negative values —175 goes to —180 and —174 rounds to 
170: 


: ROUND ( N1 --- N2 /Leaves N2 as N1 rounded to nearest 10 e) 
10 /MOD SWAP S/ 4+ 10 @ ; 


2.9 SIGNUM 
This function returns the sign of a number, or zero if the number is Zero. 


> SGN ( N1 --- N2 /Return sign if non-zero, else 2ero *) 
DUP IF 1 SWAP ¢- THEN ; 


If zero is on the stack, the condition is false and the zero remains, otherwise ¢- 
applies the sign of the stack item to 1 which is left instead. 


2.10 NOT WHAT IT SEEMS 


Boolean values are either false or true, 1.e. represented by O for false and 
either +1 or —1 for true. The logical operators AND OR and XOR act on all 
corresponding bits in a 16-bit value (or ‘cell’ in Forth terminology). In so 
doing they leave a 16-bit valuc as opposed to a two-valued Boolean flag. 

in some Forths, NOT is defined identically to 0= but in practice this is not 
always so. NOT 1s sometimes defined to perform a one’s complement operation 
in which case NOT applied to a positive number which is a Boolean true leaves 
a nepative number which ts also a Boolean true - NOT what was intended. It 
is safer to use 0= which is what it says, true if non-zero, else false. The comple- 
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ment of this ts 0<> and is defined simply: 
- 0< D=0s ? 


Suppose we have the situation where we want a true flag to result from a logi- 
cal AND of two given non-zero numbers. It is tempting to assume that each 
numbcr is a Boolean true and therefore the logical AND of the two numbers 
will suffice. A moment's thought will show that a statement such as: 4 2 AND is 
false. The bit patterns for 4 and 2 do not have any 1s in common. What ts 
required is 0<> after each number to convert the non-zero number to a Boo- 
lean true flag. The logical AND may then be correctly performed on the flags. 

Note also that while a Boolean false is zero, a true flag may be | tn early 
standards and —1) (all bits set) in later standards. Finally, you should never 
mix logical ‘values’ with arithmetic values in computations. Such attempts would 
probably not work correctly on all Forth systems and would be difficult to 
understand at a later date. 


2.11 HAVING DONE 


Use of the word EXIT is not considered to be good programming practice since 
this unstructured word will leave a definition prematurely. flowever, it has its 
uses and can sometimes make a neater job of a complex multiple structured 
word. It may not be used in a DO... LOOP where the use of LEAVE should be 
considered instead. 


: EXIT ( --- /Exit immediately from the current definition *) 
R> DROP ; 


Bv simply dropping the address on the return stack, after EXIT the interpreter 
goes to the next word after the semicolon of the word using EXIT. Use it, if 
vou must, with caution. Make sure that the return stack does contain what ts 
expected on top, not something arising from >R or a loop. Note also that in 
'79-standard and later standards EXIT is sometimes used outside a definition 
instead of \S or FigForth’s ;S to signify when to stop compiling a screen. 


2.12 FAMILY OF WORDS TO MANIPULATE BYTES IN A CELL 


These words are useful for data packing, sorting, and graphics byte manipul- 
ations. The first here - CSWAP — interchanges the high and low bytes of the top 
stack value. 


CODE CSWAP TOP LDA, TOP 1% LOY, TOP 1+ STA, TOP STY, 
NEXT JMP, END-CODE 


Defined without the assembler, this becomes: 


REX 

CREATE CSWAP ( N1 --- N2 /Swap hi & lo bytes *) 
O0OB5 , O1B4 , 0195 , 0094 , 4€ C, 0642 , SMUDGE 

DECIMAL 
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The word CSPLIT takes the high and low bytes of the top stack item and leaves 
them on the stack as two separate Items: 


: CSPLET ( N --- HI LO /SPLIT HI & LO AS TWO ITEMS ») 
0 256 U/ SWAP ; 


Firstly it is necessary to make it an unsigned double precision number so that 
the high order bit is not regarded as the sign. U/ leaves a remainder and quo- 
tient corresponding to the two bytes concerned. Alternatively (SPLIT may be 
defined in code: 


CODE CSPLIT DEX, DEX, 
TOP 2¢ LDA, TOP STA, 
TOP 3 + LDA, TOP 24 STA, 
TOP 3+ STY, TOP 1% STY, NEXT JMP, END-CODE 


Naturally if there is a nced to split a word, it follows that there will be a 
requirement sometime to join two separate values each less than 256 and rep- 
resenting the required high and low byte values of the joined word. 


: CJOIN ( HI LO --- N /JOIN TWO WORDS AS ONE *) 
SWAP 256 * OR ; 


In most instances the sequence of split bytes is quite arbitrary, so that if lo/hi 
Is preferred, both occurrences of SWAP can be omitted. However, if the CODE 
definition is being employed, some rewriting will be necessary. 

When values are stored in variables or arrays, the contents of two addresses 
may need to be swapped as is done in some sort routines. VSWAP will exchange 
the two values. 


: VSWAP ( addr1 addr2 --- /Swaps the address contents h) 
DUP >R @ SWAP DUP @R> ! ! 


8 
a 


The operation of VSWAP is straightforward. 


2.13 A COMPLEMENT OF TWOS 


Frequently definitions are required that involve the figure 2. This section 
covers an assortment of such definitions. 


» Qt ( N -*- 2*N /Doubles top of stack value *) 
DUP + ; 


The above definition simply doubles the top stack value, be it positive or 
negative. However there are occasions when an ‘arithmetic shift left’ is 
required and the high level definitton becomes more complicated and too 
slow. The following CODE definitions are presented as an alternative: 


CODE 2s ( U --- 2eU /does arithmetic shift left *) 
TOP ASL, TOP 1+ ROL, NEXT JMP, END-CODE 


Or without requiring the assembler: 
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HEX 

CREATE 2% ( U --- 2#U /Return unsigned times 2 CASLJ *) 
0016 , 0136 , 4C C, 0642 , SMUDGE DECIMAL 
( TOP ASL, TOP 1# ROL, NEXT JMP, ) 


In arrays and look-up tables, not only do we require the multiplication by two 
but also an offset, or base address must be added. Table look-up 1s consider- 
ably faster if these computations are combined and performed in code. 
2%4 does this. 


CODE 2%+ ( addr N --- addr+2#N /mult by 2 & add base address *) 
TOP ASL, TOP 1+ ROL, CLC, TOP 2+ LDA, TOP ADC, 
TOP 2+ STA, TOP 3+ LDA, TOP 1+ ADC, TOP 3 + STA, 
PoP JMP, END-CODE 


The converse of 2* is 2/ which performs an arithmetic shift nght. Note that 
this may not be the same as signed integer division if the number is negative. 


CODE 2/ ( U --- U/2 /does arithmetic shift right ) 
TOP 1+ LSR, TOP ROR, NEXT JMP, END-CODE 


Alternatively, using the hand assembler definitions: 
:CODE 2/ 0156 , 0076 , ;NEXT 


Powers of two, although having computational value, are also required to 
control specific bits of a port. Unsigned operations are necessary for this 
purpose and the definition of 27 meets this need. 


: af -( U --- 2tU /Arithmetic shift left 1 U times *) 
32768 SWAP -1 DO 2* LOOP ; 


Alternatively in code: 


CODE 2? ( U --- 2tU /given U £0-15], leaves 16-bit 2fu t) 
TOP LDA, TOP STY, TAY, ( set count of shifts left ) 
SEC, BEGIN, TOP ROL, TOP 14 ROL, CLC, ( do shift ) 
DEY, O< UNTIL, 
NEXT JMP, END-CODE 


Without the assembler this becomes: 


QO « CODE FOR 2fu ROG-831106 } 
1 HEX 

2 CREATE 2¢ ( U--- 2%U  /RETURN UNSIGNED POWER OF 2 ) 
3 0085 , 0094 , A&C, 38 C, 0036 , 0136, 

4 18 C, 88 C, F810 , 4C C, 0642 , SMUDGE 

5 DECIMAL 

6 ( LOA 00,X GET LSB TO ACC 

? Sty 00,X CLEAR LSB TO 0 

8 TAY SET SHIFT COUNT 

.) SEC GET A ‘1! 

10 LOOP ROL 00,Xx INTO LOW 
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11 ROL 01,X DO 16-BIT SHIFT 

12 CLC GET A 'O' FOR REMAINING BITS 
13 DEY COUNT SHIFTS 

14 BPL LOOP 

15 JMP NEXT ) 


The complement of 2¢ I have called /2¢. It is equivalent to 2{N, but with N 
negative. 


> /2t ( U1 U2 --- U1/2tU2 /does U2 right shifts of U1 *) 
-DUP IF 000 2/ LOOP THEN ; 


D/2¢ is a double-precision version which enables logical right shift to cross the 
16-bit boundary. 


: 0/24 ( UD U --- UD/2tU /LOGICAL SHIFT RIGHT U TIMES t) 
0d0 O 2U/ -ROT 2 .U/ SWAP DROP SWAP LOOP ; 


The implementation in code for this is given below using the hand assembler 
definitions: 


CODE 0/2¢ ( UD U --- UD/2tU /DIVIDE BY 2 FOR U TIMES *) 
0085 , OCFO , 0356 , 0276 , 0576 , 0476 , 0006, 
F4D0 , ;POP 


Project 


Write a definition to print non-destructively the contents of the return stack. 
Modify your definition to display additionally the corresponding name with 
1). {Incorporate a test to restrict printing to colon definitions only. 


REFERENCES 


[1] Lawrence, P. ‘Recursive PICK and ROLL' Forthwrite No. 19, U.K. Forth Interest 
Group 
{2] Nemeth, G. ‘Within WITHIN’ Forth Dimensions, V, No. 5, p31 


3 Double Number Definitions 


Some controversy exists in Forth circles as to whether the double number 
word extensions should be prefixed with a 2 or D. Originally the prefix was 2 
hecause they were meant for operation on pairs of 16-hit numbers, but later 
Opinions have mooted 0 for Double numbers, t.e. 32-bit. It follows therefore 
thar you may need to change 2s to Ds according to the implementation in use. 
In gencral, standards appear to have és for stack manipulations and Ds for 
arithmetic opcrations, although there are no solid rulcs. What ts preferred is 
that D should apply only to double-precision numbers and 2 to hoth double 
numbers and to two singie- precision numbers. 

Double numbers are represented by pairs of 16-bit integers, which them- 
selves are pairs of bytes on 8-bit microprocessors. The number range spanned 
is —2 147483 648 < 0 < +2 147483647. The stack sequence is: low number 
(hi/lo), high number (hi/lo), the high number holding the sign and being on 
top. 

The first batch of definitions are fairly commonplace: 


: 2SWAP (D1 02 --- D2 01 /SWAP TWO DOUBLE NUMBERS +) 
ROT >R ROT R> ; 


or alternatively: 


4 ROLL 4 ROLL ; 


: 2ROT ( D1 02 D3 s-- D2 03 01 /DO A ROTATE WITH DOUBLES *) 
>R >R 2SWAP R> R> 2SWAP ; 


 2DROP ( D --- /DROP DOUBLE OR TWO SINGLE NUMBERS +) 
DROP DROP ; 

: 20UP ( D --- D D /DUPLICATE TOP DOUBLE NUMBER *) 
OVER OVER ; 

> 20VER ( D1 D2 --- 01 D2 01 /COPY SECOND DOUBLE TO TOP *) 


4 PICK 4 PICK ; 


If your implementation is pre-’79-standard, and PICK is missing, you could for 
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this specific instance define 4PICK thus: 


: 4PICK ( COPY 4TH STACK ITEM TO TOP *) 
>R >R OVER R> SWAP R> SWAP ; 


and hence define 20VER as 4PICK 4PICK;. Defining 20VER in this manner does, 
however, lead to far more stack manipulations and hence a slower version 
than is necessary. By rethinking the problem a more suitable alternative 
results: 


: 20VER ( D1 D2 --- 01 02 D1 /COPY SECOND DOUBLE TO TOP~ «*) 
>R >R 20UP R> R> 2SWAP ; 


DMAX and DMIN are the double number equivalents of MAX and MIN. They 
operate on pairs of double numbers. D< is ‘79-standard and is defined later. 


: DMIN ( D1 02 --- 03 /LEAVE MINIMUM OF TWO DOUBLE #'S ) 
20VER 20VER D< O= IF 2SWAP THEN 2DROP ; 


: OMAX ( D1 02 --- D3 /LEAVE MAXIMUM OF TWO DOUBLE #'S ) 
2OVER 20VER D< IF 2SWAP THEN 2DROP ; 


3.1 DOUBLE NUMBER STORAGE 


Double number variables and constants are not included in carhier standards. 
The definitions are straightforward and should be self-explanatory. 


: 20 ( ADDR --- D /FETCH DOUBLE NUMBER FROM ADDRESS *) 
DUP 2+ gd SWAP a ; 


rp! ( D ADDR --- /STORE DOUBLE NUMBER AT ADDRESS *) 
DUP >R ' R> + ! 3} 
: 2CON ( Defines 32-bit double constant t ) 


CONSTANT , DOES> 2a ; 


: 2VAR ( Defines 32-bit double number variable in Figforth *#) 
VARIABLE , ; 


: 2VAR ( Defines 32-bit double number variable '79-std *) 
VARIABLE 2 ALLOT ; 


It may be preferable to use the names 2CONSTANT and 2VARIABLE for compat- 
bility with later standards. The stack behaviour for 2VAR is similar to VARIABLE, 
1.e. early standards require the default value on the stack when the variable ts 
defined. Versions using <BUILDS or CREATE do not usually require the default 
value. 


22 Forth: The NEXT Step 


3.2 DOUBLE OPERATORS 


*0= ( 01 02 --- D3 /DOUBLE NUMBER SUBTRACTION * ) 
OMINUS Dé ; 

: DO= ( 01 --- F /LEAVE TRUE FLAG IF DOUBLE NUMBER IS ZERO *) 
OR = ; 

; DO< ( 01 --- F /LEAVE TRUE FLAG IF DOUBLE NUMBER -VE a) 


SWAP DROP O< ; 


: D= ( 01 02 --- F /LEAVE TRUE FLAG IF BOTH EQUAL *) 
D- OO= ; 

: O< ( 01 02 --- F /'79-STANDARD DOUBLE COMPARE ) 
D- odO< ; 

: 0 ( 01 02 --- F /LEAVE TRUE FLAG IF D1 > D2 *) 
2SwAP DC ; 

: DU< ( UD1 UD2 --- F /COMPARE UNSIGNED DOUBLE NUMBERS t) 


32768 + ROT 32768 + -ROT D< ; 
or alternatively a longer, but faster version is: 
>R >R 32768 + R> R> 32768 + OK |; 


The arithmetic shift left of 2* can be extended across a second word using the 
coded version 02s: 


HEX 

CREATE D2* ( UD --- 2#UD /RETURN UNSIGNED TINES 2 a) 
0016 , 0136 , 0236 , 0336 , 4€ C, 0642 , SMUDGE 
( TOP ASL, TOP 1¢ ROL, 
TOP 2+ ROL, ROL 3 + ROL, NEXT JMP, ) 

DECIMAL 


Although D+- is a required word, it may be lacking in some implementations. 
DMINUS may need replacing with DNEGATE. 


: O4- ( D1 N === D2 /APPLY SIGN OF N TO D1 AND LEAVE AS D2 *#) 
O< IF DMINUS THEN ; 


Finally, multiplication of two double-precision numbers need not require a 
quadruple-precision, or even triple-precision result since quite large numbers 
can be handled before overflow occurs. It may be essential to retain double- 
precision throughout in an iterative procedure or other looping condition and 
if so O* will fulfil this need. 


: De ( D1 02 --- 03 /DOUBLE NUMBER MULTIPLY +) 
OVER 5 PICK U* 6 ROLL & ROLL * + 2SWAP @ + ; 
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De works using the relationship 
(ath)(c+d) — actadt be+ bd 


to calculate the result. where ) and d are the high bytes. [hire and sourth 
order terms are ignored hecause they represent cvertiow, hence bd. s fourth 
order term, is omitted as arc the high bytes of tee products ad anc bc which 
are third order. One could check these terms beforchand and if any of them 
are non-zero then performing the multiplication will give rise [oO Cver}ow 
error. Note that in Forth-’83 standard PICK and ROLL wit require the preced- 
ing number to be deercased by onc. 


3.3. MIXED OPERATORS 


Labelling conventions for double numbers were discussed, Mennoninys the 
two schools of thought. With mixed number definitions, no suck thouz2ht 
appears to exist. There are no formal standards for mixed numbers and sc 
combinations of U, M, D and an operator are often used with onlv a passing 
resemblance to logical naming conventions. To make matters worse. the 
Forth-'83 standard renames U* as UM* — oh dear! 


5 et ( DIN --- D2 /ADD SINGLE TO DOUBLE SRECISITUN NUMBER *° 
s7>D D+ ; 


This simply converts the single-precision number to double and then performs 
a double-precision addition. 


: UMS (CU D1 === D2 /MIXED NUMBER MULTIPLICATION r 
>R OVER U® ROT R> * + : 


An alternative definition using a different stack sequence i-: 


> UM® ( D1 U s=- D2 /MIXED NUMBER MULTIPLICATION 
DUP ROT * -ROT U* ROT + 


o 


The above two definitions work with U up to 65 535, but the resulting, prodiuct 
must be less than 2°! (+2 147 483 647) or overflow wiil occur. 


3.4 MIXED NUMBER DIVISION 


The normal Forth operators for division include / and the primitive U/. Both 
of these Icave a single-precision result. but if a large number is divided by a 
small number, the result is still a large number. {f the numerator 14 double- 
precision, then we require a double-precision quotient. 


> UM/ ( D1 U --- 02 /MIXED NUMBER DIVISICK ¢) 
SWAP OVER /MOD >R SWAP U/ SWAP DROS R> 


UM/ works with U < 32768. but ahove thal i depends on the numbers 


presented to U/ which treats values as unsigned. In '79-standard. U/ becomes 
U/MOD and its renamed UM/MOD in ‘83-standard. !f you find that confusing, here 
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iS a definition for M/M0D which divides an unsigned double-precision number 
by an unsigned single-precision number, leaving a remainder U2 and a douhle- 
precision quouent. 


: M/MOD ( UD1 U1 -2* U2 UD2 /DIVIDE & LEAVE REM & D-QUOT *) 
>R ORC or RA ) US R> SWAP OR US RD ; 


The same comments regarding standards and naming conventions apply. 

The double scalar word M*/ performs one of the more useful mixed 
operations. It is similar to *#/ in its action, but acts on a double number using 
an intermediate triple-precision result. It will occur frequently in later chap- 
ters. 


0 ( DOUBLE SCALAR M#/ RDG-B31214 ) 
} 

2: Me/ ( D1 N1 N2 --- D2 /AS FOR #/ BUT OPERATES ON DOUBLES *) 
3 2DUP XOR SWAP ABS >R SWAP ABS oR 

. OVER XOR -ROT DABS SWAP R U* ROT 

S R> U® ROT O D* R U/ -ROT R> U/ 

‘ SWAP DROP SWAP ROT De- ; 


In some Forths R will need to be replaced by Ra. -ROT is a word previously 
dcfined which rotates the top three stack items, lke ROT, but in the other 
direction. 


3.5 MISCELLANEOUS 


Some definitions are difficult to quantify under any specific heading and so a 
‘miscellaneous’ heading becomes inevitable. For example, to transpose the top 
three stack items most readers will use SWAP ROT but to transpose the top four 
is a little more complicated. Further than this it would be worth considering a 
more general definition to transpose the top N items. 


: GSWAP ( N1 N2 N3.N4 --- NG N3.N2 N1 /TRANSPOSE TOP FOUR *) 
SWAP 2SWAP SWAP 


This apparent simplicity of 4SWAP has hidden within 2SWAP several SWAP and 
return stack moves which, if factored out in full, show a similarity to SWAP ROT 
when ROT ts factored likewise. 

Another oddment here called A-8/A+B (for that is what it does, brackets 
notwithstanding) is used in a number of mathematical functions, e.g. loga- 
rithms of large numbers. Since the function is always less than unity for 
positive B, it is scaled by 10 000. 


: A-B/A*B  ( NI N2 --- N3 /Compute difference/sum * 10K % ) 
2DUP - -ROT ¢ 10000 SWAP */ ; 


The numerator is generated by 20UP - and then moved by -ROT under the orig- 
inal two stack values. The addition is performed followed by the scaled 
division using */ to Jeave the result, times 10000, on the stack. 
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Projects 


1. Write a definition D/ to complement 0* to perform division ( 01 02 --- 
03 ). What are the limitations, if any, on the values of D1 and 02? 

2. Rewrite the definition of UM/ to handle a signed denominator (if you 
are stuck, try simplifying M*/ by making N1= 1). 


4 Formatting 


The simplest formatting definition that I know is: 


& Ui ( U --- /Print the top stack number as unsigned +) 
0... ; 


U. is a required word in '79-standard and later versions, but does not appear 
in FigForth. It prints the top stack item as unsigned, i.e. 0<U < 65 536 and is 
useful for printing 16-bit addresses, either in hex or decimal. Following on 
from this is U. R which is similar to U. but will right-justify the number in a field 
width of N. 


: UR. ( UN --- /OUTPUT U IN FIELD-WIDTH N e) 
QO SWAP DLR ;: 


UD.R is the double-precision version which is totally different in its definition: 


: UD.R ( UD N --- /OUTPUT UD IN FIELD-WIDTH N *) 
, >R <A WS &> R> OVER - SPACES TYPE ; 


This operation gives the following interesting result: 


-71. 12 CR UD.R 
4294967295 OK 


Explanation of Forth’s inherent formatting words, <# ... 4#> and the like, 
together with .R and 0.R etc. are well documented in the literature. These give 
tremendous flexibility in the presentation of output values without too much 
difficulty. In this section we shall look at some particularly useful or interest- 
ing applications, 


4.1 .HMS - PRINT HOURS, MINUTES AND SECONDS 


The definition .HMS takes the contents of the variables MINS and SECS and 
formats the values in the form HH.MM.SS but SECS should be modulo 60 and 
MINS modulo 1440 (24 x 60). Normally contro! of the modulus is invested in 
the mechanism for incrementing or decrementing the variables. 


SCR #116 
0 ( FORMATTING RDG-840818 ) 
4 
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Formatting 
2 0 VARIABLE MINS OQ VARIABLE SECS 
3 
4: Aé ( CONVERT DIGIT AS BASE 6 + 
5 6 BASE ! # DECIMAL ; 
6 
7: AA. ( CONVERT TWO DIGITS AS BASE 60 * 
8 46 HOLD A Wb ; 
9 
10 : .HMS ( o-- /PRINT THE TIME AS HH.MM.SS * 
11 MINS 2 0 <# AA. HH. A> CR TYPE 
12 SECS QO <H # 866) OAD «OTYPE CR; 
13 --> 


14 MINS SHOULD BE MODULO 1440 FOR CORRECT OPERATION ... 


4.2 LAT/LONG 
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) 


) 


) 


Much of the above is similar to the formatting of angles as latitude and longi- 
tude in the form 0D. 4M.Mn or s and DDD.MM.Me or w from a double number 
representing degrees X 65536. This format enables the degrees to go up to 
65535 and the minutes of arc to be resolved to one 65 536th part of a degree. 
For astronomical calculations it may be preferable to employ minutes of arc X 
65536 as a more useful scaling factor. In the examples, the appropriate 
compass quadrant is appended at the end. 


SCR 117 

O ( FORMATTING RDG-840818 } 
‘ 

2: GETDEGS ( D --- SGN LO HI /PREPARE DEGREES #) 
3 SWAP OVER DABS 55. D¢# ; 

4 

5 : MINSOUT ( U --- /FORMAT MINUTES e 
6 46 EMIT 0 150 16384 Me/ ( TO 1/10 MINUTES ) 

7 <H oH AW, A> TYPE 

8 

9 : 2N-S ( F --- /OUTPUT N OR S *) 
10 IF 83 ELSE 78 THEN EMIT ; 

11 

12: ?E-W ( F --- /OUTPUT E OR W *) 
13 IF 87 ELSE 69 THEN EMIT ; 

14 

15 ==> 
SCR #118 


0 ( FORMATTING 
1 
2: 2NUMS ( 


U 


RDG-840818 | 


--- /OUTPUT U FORMATTED AS TWO DIGITS *) 
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0 <A oo oH W> TYPE ; 


3 

oo 

5 : 3NUMS ( U --- /QUTPUT U FORMATTED AS THREE DIGITS a 
6 0 <# # &# WH > TYPE ; 

7 

8 : LAT ( D --- /DISPLAY DEGREES LATITUDE *) 
9 GETOEGS 2NUMS MINSOUT OQO< 7N-S ; 

10 

11: LONG ( D --- /DISPLAY DEGREES LONGITUDE 2) 
12 GETOEGS 3NUMS MINSOUT OQ< 7E-W ; 

13 

146 : MINS ( U1 U2 --- D /CONVERT DEG & MINS OF ARC TO O-DEG *! 
15 >R O SWAP O R> 60 U/ SWAP DROP ( rem) QC DF ; 


GETDEGS extracts the sign and rounds the angle to 1/10 minute of arc. MINSQUT 
converts the fractional part of the degrees to tenths of minutes and then out- 
puts the resulting number formatted with stops. 

2N-S outputs N or § according to the state of the flag on the stack. Similarly 
with 7E-W. 2NUMS and 3NUMS print the appropriate number of digits, two for lati- 
tudes and three for longitudes. 

LAT and LONG are the keywords which use the foregoing to process the 
double number in degrees X 65536 and produce a formatted pnntout of 
angle. 

+MINS is used to create the double number degrees from the degrees U1 and 
minutes U2. 1 is multiplied by 65536 by the action of 0 SWAP and U2 Is effect- 
ively multiplied as a result of the second zero and then reduced by a factor of 
6(). The remainder from the division is dropped and the quotient made 
double-precision before adding to the degrees. The polarity may then he 
adjusted if necessary by OMINUS or ONEGATE as appropriate. 

Tenths of degrees may be suppressed by leaving out the 4 before #4. in 
MINSOUT and by changing the scaling factor. The 150 becomes 15 and in 
GETDEGS, SS. becomes 546. as the rounding correction. The latter figures come 
from 0.5 or 0.05 minutes multiplied by 65536 and then divided by either 60 
or 600 accordingly. 

It may be that alternative and possibly simpler ways of achieving the same 
ends exist, but as part of a larger application, many words used here are 
common to other definitions not included. The example has been explained at 
some length, not because it is particularly useful, but more to illustrate the 
principles involved. 


4.3 NAVIGATION CALCULATIONS 


Now that the concept of using a double number representation for latitude 
and longitude has been introduced it is appropriate to look at some practical 
examples for navigation. 
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4.3.) Range and bearing 


[t is at mes like this that the Flat Earth Society have an advantage. Calcu- 
lations relating to movements over the earth's surface invariably involve some 
compromise in order to yield an approximate formula. The earth is not flat; it 
is not even spherical. Many bodies get fatter around the waistline with age, 
and the earth is no exception! The reason that the earth has an equatorial 
diameter greater than across the poles is due to the forces of rotation acting 
on its mass. This difference is ignored for short distance calculations. If travel 
is not over the earth's surface, but in an aircraft, the earth’s mean radius 1s 
increased by the aircraft's height but this effect can often be ignored. 

A formula which takes into account all of the factors in the calculation 
requires a very complex piece of 3-D trigonometry. However, for modest 
distances, not only can the earth be considered sphencal, but the surface of 
interest is approximately flat. The formula for the distance between two points 
on the surface can then be calculated from the latitude and longitude of the 
point relative to the point of interest, often one’s present coordinates. The 
formula used is: 


Range = 60 X (latO — latl)- + ( (longO — long1) cos (lat0) )’ 


and is simply applying Pythagoras’ theorem on a flat earth’s surface. One 
degree of latitude is equivalent to 60 nautical miles, but going in the east/west 
direction it is reduced by the cosine of the latitude. Obviously if the north/ 
south direction is large, the cosine will be significantly different at the two 
places. 

Having determined the range, the other parameter required is the bearing 
relative to true north. If one uses the more obvious solution: 


long! — longO 


Bearing = arctan ; 
lat1 — latO 


there is a divide-by-zero problem if the two latitudes are the same, a not 
unreasonable situation. This may be avoided by using: 


— x 
Bearing = arccos  caialias| Na 


range 


The divide-by-zero problem has not gone away, but now only arises if the 
range ts zero, which is not such a likely event. 

In implementing these formulae in Forth the latitudes and longitudes are in 
the double-precision degrees format previously described. For a Forth defini- 
tion of ARCCOS see Chapter 6. 


SCR #74 

O ( RANGE/BEARING CALCULATIONS RDG-841002 ) 
1 

2: NM ( 0 --- N /CONVERT DEGS * 65536 TO NAUTICAL MILES *#) 
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3 15 16384 M*/ DROP ; ( 15 => 150 FOR TENTH OF NM ) 
4 

S : RANGE  ( DLATO DLONGO DLAT1 DLONG! --- N /RANGE IN NM *) 
é 2ROT D- NM> >R 20VER 0COS 

7 DUP M* 10K M/ SWAP DROP R> ABS DUP U® 

8 ROT 10K M#/ >R >R D- NM> ABS DUP U® 

9 R> R> D+ DSQRT ; 

10 

11: BEARING ( DLATO DLONGO DLAT1 DLONG! N --- D /DEGREES #65536 *) 
12 >R 2ROT D- DO< R> SWAP >R >R ( SAVE SIGN, RANGE ) 
13 D- 60 R> ( RANGE ) M¥/ 2500 16384 Me/ (¢ 10K/65536 ) 
14 DMINUS DROP ARCCOS R> ( GET SIGN FLAG ) 

15 IF 0 360 2SWAP D- THEN ; 


The equation holds good for distances of a few hundred nautical miles, but 
using integers this limits resolution to two or three figures. This can be 
improved by scaling by a factor of 10 or even 100. For example, in line 3, the 
15 can be replaced by 150 and in line 13, the 60 by 600 to give tenths of 
nautical miles. 

The Forth definitions are a straightforward implementation of the equation, 
except for scaling down the cosine by 10000 and the degrees by 65536. The 
expression ABS is necessary before squaring because U* would otherwise ignore 
the sign and treat the number as greater than 32767 and the last line ts to 
convert the angle to the correct hemisphere. DMINUS may need replacing with 
DNEGATE and of course DUP U* may have been factored out. 

Here are some example figures: 

origin: 51°30’'N 00°20'E 

object: 52°30°'N 01°20'E 
Range = 70.68 NM Bearing = 031°S4.2’ 


To convert degrees of arc to nautical miles at the earth’s surface, 1 degree is 
_ equivalent to 60 nautical miles and if the degrees are to be in the format 
described, NA2DEG will perform the conversion. 


O ( NM TO LAT/LONG IN DEGREES * 65536 FORMAT RDG-841002 ) 
, 

2: MS20EG ( N --- D /NM TO DEGREES LAT CLONG AT EQUATOR ONLY) *) 
3 OQ SWAP ( N->D ) 1 60 Me/ ; ( 60NM = 1DEGREE ) 
4 


If N represents tenths of nautical miles, then 6() in line 3 should be made 600 
for correct conversion. 


Project 


Write another set of definitions to display time, but on this occasion from a 
double- precision variable containing seconds (modulo 86400). Examine the 
problems of extending the time cycle from 24 hours to one week. 


5 The Real World 


5.1 LOOKING AT A PORT 


In the real world the basic computer system connects to an interface of some 
sort. In a situation where the computer is monitoring an input, say 8 or 16 
input fines, it is useful to be able to ‘see’ the status of those lines as a pattern 
of zeros and ones. BITS formats the 16-bit binary pattern into four groups of 
four. It follows that for an 8-bit port this could be modified to two groups of 
four. 


( BIT FORMATTING RDG-841014 ) 
: GH BL HOLD 4000 # LOOP ; 


0 

1 

2 

3 

4 : BITS ( N --= /PRINT N FORMATTED AS BLOCKS OF FOUR BITS +#) 
5 BASE a SWAP 2 BASE ! 

6 0 <A 4000 44 LOOP ff 

, CR TYPE BASE! ; 

8 
9 
0 
1 


> 71BIT ( N --- F /FLAG IS TRUE IF ONE & ONLY ONE BIT SET *#) 
1 DUP OUP MINUS ( NEGATE ) AND = ; 
1 
Although BITS outputs in binary, the onginal number hase is saved and 
restored afterwards. A typical format would be: 


63318 BITS 
1111 0111 0101 0110 OK 


71BIT relies on the property of two's complement arithmetic. The least signi- 
ficant bit which is set, is the only bit that is set in both a number and its two's 
complement. Now if that bit happens to be the only bit set in the original, the 
two numbers are equal and ?1B81T returns a true flag. 


3.2. WHICH BIT? 


The purpose of L0G2.N is to convert the state of an input port to a bit number. 
In practice more than one bit could be simultaneously active and the arbitrary 
choice was to make the lowest numbered bit the one of interest. 

31 
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0 ( LOGARITHM TO BASE 2 RDG-840509 ) 
1 

2: LOG2.N ( 2tN --- N /Return bit 4 of lowest bit set a) 
3 0 BEGIN OVER 1 AND O= 

4 WHILE 1% OR 2/  B— 

>) REPEAT SWAP DROP ; 

6 


As a means of finding the logarithm of a number its usefulness is limited to 
rather coarse increments. However, in case this is satisfactory 


log, = log, N X logy, 2 
or 


log,N X 0.30103 


5.3 SCANNING TWO PORTS 


Quite often the signa] presented to an input port has an active low state and 
needs to be inverted for positive logic. The definition -a fetches a 16-bit value 
and logically inverts it. When continuous monitonng of the port’s address is 
required it is a simple matter to put it in a Joop until! -@ returns a non-zero 
value. However, life isn't always that simple and to look at two ports where 
the addresses are not consecutive is more complex. The definition 322 looks at 
two 16-bit addresses and returns a value in the range 0 to 31. 


SCR #111 


0 ( PORT READING DEFINITIONS RDG-840509 ) 
1 

2: -8 ( ADDR --- N /READ THE ADDRESS, INVERT CONTENTS  #) 
3 a -1 XOR : ( -1 2 SFFFE ) 

“ 

5: 32a ( ADDR1 ADDR2 --- N /POLL ADDR1 & ADDR2, GIVE 0-31 *#) 
6 0 SWAP BEGIN OUP -a DUP O= 

? WHILE DROP SWAP O= ROT 

8 REPEAT LOG2.N ROT O= If 16 ¢ THEN 

9 >R 2DROP R> + 

10 

11 

12 
13 
14 

15 


Operation of 322 relies on alternately examining the contents of addresses 1 
and 2 while both return a zero from -d. As soon as a non-zero is found the 
looping around ends and the contents are converted to a bit number. In order 
to determine which of the two addresses yielded a response, a flag is alter- 
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nated between 0 and 1 and is used to shift address 1’s contents to number 16 


to 31. 
When the loop is entered at BEGIN the stack contains 


ADDR’ O ADOR2 
and just before WHILE the sequence is 
ADOR' O ADDR2 (ADDR2) f 


where (AODDR2) is the contents of address 2 as inverted by -@ and f is an exit 
flag which is true if no active low input ts present. If true then the contents are 
discarded, and the stack is shuffled to present: 


ADDR2 1 ADDR1 


by the time REPEAT is encountered, so that when returning to BEGIN the 
addresses have changed places and the address flag Boolean value is inverted 
(next time round 0= will change the 1 to 0). 

If -d returns a non-zero value the flag preceding WHILE will be zero and 
LOG2.N will convert the value to a number in the range 0 to 15 according to the 
lowest bit set. If the address flag is true then an offset of 16 1s added to the 
number from address 2 to distinguish the signals from address 1. Finally the 
two addresses are dropped from the stack leaving just a number in the range 0) 
to 31. 


5.4 HISTORY 


In order to keep a record of past values of, for example, an input port, a 
buffer store is used. The store is required to remember the last N values of 
interest. To do this a buffer is created such that before entering a value, all 
previous values are moved up with the earliest being lost. The latest value is 
then entered. No provision has been made to initialize the buffer; it depends 
on its use as to what default values, if any, are required. 


SCR #144 

QO ( HISTORY STORE RDG-841210 ) 
1 

2 5 CONSTANT LENGTH 

3 O VARIABLE KISTORY LENGTH 2 - ALLOT 

4 

a el? ( C --- /STORE PAST CHARACTER HISTORY *) 
6 HISTORY DUP 1- DUP LENGTH + i- 

? 00 I Ca 11+ c¢! -1 +LooP Cc! ; 

8 

9 

10 

11 

12 
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C!! moves each byte stored up one, losing the oldest value, and stores the 
latest byte. A 16-bit word version would be similar, but with 2s instead of Is 
and using 16-bit store and fetch words. Operation is straightforward, but care 
is needed in the definition to avoid an ‘out by one’ error in the store address- 
ing. According to the standard in use define HISTORY in the form: 


CREATE HISTORY LENGTH ALLOT 


5.5 LABELLING THE 6522 VIA CHIP 


The processor dependent software in this book has been onentated towards 
users of the 6502 processor and a commonly used peripheral chip with this 
processor is the 6522 Versatile Interface Adapter (VIA). Control of bits in 
the 6522 registers using Forth can lead to some fairly unreadable statements. 
For example, rather than writing: 


$9437? Cad 127 AND 59437 C! 
a more readable version would be 
OVIA IFR 7? BIT-OFF 


This may be realized by assigning a name to the VIA base address and suit- 
ably naminy the addresses of the internal registers as in the 6522 data sheet 
and detining them as offsets. 


SCR #149. 

0 ( 6522 VIA CHIP CONTROL DEFINITIONS RDG-840523 ) 
1 

2 $E€800 CONSTANT 1VIA 

3 $6820 CONSTANT 2VIA 

4 

5 (€ ADDR1 --- ADDR2 /ADD OFFSET FOR VIA REGISTE *) 
6 : ORB ( $OF +) ; > ORA soi+ ; 

7 + DORB $02 + ; : DORA $O3 + ; 

B : TICL $04 + ; : TIC-H $0o5 + ; 

9: TiLet $064 ; : TIL-H $07 + ; 

10.3 Tee=l $08 + ; : T2C-H $09 + ; 

11.5 SR SOAs ; > ACR soB + ; 

12 : PCR soc + ; > IFR $00 + ; 

13: IER SOF + ; 

14 

1§ 


The ORB register appears as two discrete addresses, one with zero offset, the 
Other with $0F offset. If you need further details of the VIA and its operation, 
you should refer to the data sheet since the object here is to explain a defining 
technique for program readahility. 

After the register addresses come the individual bits within those registers. 
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Four words are defined which yield an individual bit's status, set or clear a 
specificd bit, or toggle a specified bit. The bit number ranges 0 to 7 as defined, 
but may be readily changed to 0 to 15 as required. 


SCR #148 
O ( BIT-MANIPULATION, C => 0 107 RDG-830405 ) 
1 
2: BIT? (C ADOR --- F /1 2 0N Q = OFF *) 
3 Ca SWAP 2% AND O= O= ; 
S$ : BIT-ON (¢ C ADDR --- /SET SPECIFIED BIT ON *) 
6 DUP >R Ca SWAP 2? OR R> C! 
? 
8 : BIT-OFF ( C ADDR --- /TURN SPECIFIED BIT OFF *) 
"9 DUP >R Ca SWAP 24 255 XOR AND R> C! ; 
10 
11: BIT-TOGGLE ( C ADOR --- /TOGGLE SPECIFIED BIT *) 
12 SWAP 27 TOGGLE ; 
13 
14 
15 


The word 27 may be high-level or code as desired. We may now turn off bit 7 
of the interrupt flag register of the second VIA chip with 2VIA IFR 7 BIT-OFF 
as before. 


Project 


Define a word SEE. HISTORY to reveal the current byte contents of the ‘history’ 
Store. Test it thoroughly to avoid an ‘out by one’ error. Write the equivalent 
definitions for 16-bit data. What are the problems in identifying initial 
garbage from valid data? 


6 Mathematics 


6.1 TRIGONOMETRIC FUNCTIONS 


The philosophy that is adopted here for trigonometric functions is that for any 
given application, only one such function is required. As a result that function 
must as far as possible be a ‘stand-alone’ definition which does not depend on 
other trigonometric functions being present for its operation. There are a 
number of ways of implementing ‘trig’ functions in Forth and each has its 
particular advantages and disadvantages. Assuming that a floating point pack- 
age is not available, it comes down to making the best use of integer arith- 
metic. The final choice ts from a trade off between speed, memory space and 
resolution. 

Where resolution ts required, it is not sufficient to use degrees of arc alone. 
Here the previously mentioned method of employing a double number is 
used. The high digit is still degrees, but times 65536. The low order digit is 
the fractional part, although this too is times 65536. To convert this format 
back to signed single-number format you should use 0->S: 


+ D235 ( D --- N /CONVERT D-DEGREES TO N WITH ROUNDING ¢) 
32768 0 D+ SWAP DROP ; 


When using sines and cosines the result obtained is within the range plus or 
minus one. To overcome this fractional problem a scaling factor must be 
introduced: typically 16384 and 10000. The former gives slightly more 
accuracy, while the latter gives a more readable result and is used here. 


6.1.1 Sine function 


The usual method of producing a sine function in Forth is by look-up table. 
This has the advantage of speed, but at the expense of memory. The finer the 
increments, the more storage is required. An alternative is to evaluate a series. 
This ts the technique used by Bumgarner [1]. 


0 ( SCALED INTEGER SIN FUNCTION JOB-82MAR31 ) 


1 
2 10000 CONSTANT 10K ( THE SCALING CONSTANT ) 
3 Q VARIABLE XS ( THE SQUARE OF THE SCALED ANGLE ) 


4 
5: KN ( A B --- M /M=1Q0000-AX*X/B ..A COMMON TERM IN SERIES *#) 
36 
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6 XS a SWAP / MINUS 10K #/ 10K ¢ ; 
7 

8 : (SIN) ¢( THETA --- JO0K#SIN /-15708<THETA<15708 RADIANS * 10K #) 
9 DUP 10K */ XS ! ( save xf2 ) 10K ( start series ) 
10 72 KN 42 KN 20 KN 6 KN 10K #/ ( times x ) |; 
11 

12 : SIN ( THETA --- 10K#SIN / 0 - 90 DEGREES ONLY + ) 
13 17453 100 */ (SIN) ; (¢ DEG TO RADIANS#10K) 

14 3S 


15 SIN(X) = X@C1-K92/6 (1-X92/20 (1-K12/62 (1-KX42/72 )))) APPROX. 


Depending on your implementation, MINUS may need replacing with NEGATE 
(‘79-standard and later) and VARIABLE will not need the preceding zero. 


6.1.2 Cosine function 


The usual method of producing a cosine function is to convert the angle so 
that the sine table can be used. The expression is 


cos(A) = sin(90—A) 


If the cosine function is all that is required, it may be obtained by using a 
series which has similarities to that used for sine. 


O ( SCALED INTEGER COS FUNCTION - after J.0.B. ROG-840525 ) 


10000 CONSTANT ‘10K ( THE SCALING CONSTANT ) 
QO VARIABLE XS ( THE SQUARE OF THE SCALED ANGLE) 


ra 
3 
4 
5 : KN ( AB --- M /M=10000-AX*X/B ..A COMMON TERM IN SERIES *) 
6 XS a SWAP / MINUS 10K #/ 10K + ; 

7 

8 


: (COS) ( THETA --- 10K#COS /-15708<THETA<15708 RADIANS © 10K *) 


9 DUP 10K #/ XS! ( SAVE xf2 ) 

10 10K ( Start series ) 56 KN 30 KN 12 KN 2KN ; 
11 

12 : £COS)] ( THETA --- 10K*#COS / 0 - 90 DEGREES ONLY t) 
13 17453 100 #«/ (COS) ; (¢ DEG TO RADIANS#10K ) 

14 --> 


15 COS(X) = (1-KF2/2 (41-K92/12 (1-K72/30 (1-x72/56 )))) APPROX. 


6.1.3 DCOS 


If the angle is presented in the format degrees X 65 536, then DCOS will return 
the cosine X 10000. 


O (€ DCOS - DOUBLE COSINE RDG-840606 ) 
1 . 
2: COS ( N --- 10K#COS /GIVES COS FOR ALL DEGREES t) 
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6 XS a SWAP / MINUS 10K #/ 10K + ; 

7 

B : (SIN) € THETA --- 1OK@SIN /-15708<THETA<15708 RADIANS * 10K *#) 
9 DUP 10K *#/ XS ! ( save x#2 ) 10K ( start series ) 
10 72 KN 42 KN 20 KN 6 KN 10K */ ( times x) ; 
11 

12 : SIN ( THETA --- 10K*#*SIN / 0 - 90 DEGREES ONLY +) 
13 17453 100 #/ (SIN) ; ( DEG TO RADIANS*#10K) 

14 ;$ 


15 SINCX) = XeC12X2/6 (1-KF2/20 (1-xt2/62 (1-K92/72 )))) APPROX. 


Depending on your implementation, MINUS may need replacing with NEGATE 
('79-standard and later) and VARIABLE will not need the preceding zero. 


6.1.2 Cosine function 


The usual method of producing a cosine function is to convert the angle so 
that the sine table can be used. The expression is 
cos(A) = sin(90—A) 


If the cosine function is all that is required, it may be obtained by using a 
series wnich has similarities to that used for sine. 


O ( SCALED INTEGER COS FUNCTION - after J.0.B. RDG-840525 ) 
: 
10000 CONSTANT 10K ( THE SCALING CONSTANT ) 
O VARIABLE XS ( THE SQUARE OF THE SCALED ANGLE) 


2 
3 
“ 
5 : KN ( A B --- M /M=10000-AX#X/B ..A COMMON TERM IN SERIES #) 
6 XS @ SWAP / MINUS 10K */ 10K + ; 

? 

8 


> (COS) ( THETA --- 10K@COS /-15708<THETA<15708 RADIANS ® 10K *) 


9 DUP 10K #/ XS ! ( SAVE xf2 ) 

10 10K ( Start series ) 56 KN 30 KN 12 KN 2 KN ; 
11 

12 : [COS] ( THETA --- 10K*COS / 0 - 90 DEGREES ONLY *) 
13 17453 100 #/ (COS) ; ( DEG TO RADIANS#10K ) 

14 --> 


15 COSCX) = (1-KXf2/2 (1-K42/12 C1-K42/30 (1-x42/56 12) APPROX. 


6.1.3 DCOS 


If the angle is presented in the format degrees X 65536, then 0COS will return 
the cosine X 10000. 


0 ¢ DCOS - DOUBLE COSINE RDG-840606 ) 
1 
2: COS ( N --- 10K®COS /GIVES COS FOR ALL DEGREES *) 
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360 40D ABS OUP 270 > IF 360 - THEN DUP 
90 > IF 180 SWAF - (COS] MINUS ELSE [COS] THEN ; 


3 
4 
5 
6 : (0C0S] ( D --- 10K*COS /GIVES COSINE FOR DEGREES * 65536 *) 
7 20 7510 M*/ DROP (COS) ; 

8 


9: DCOS ( D --- 10K#COS /GIVES COSINE FOR DEGREES * 65536 +) 


10 360 MOD DABS DUP 270 > IF O 360 D= THEN DUP 
11 90> IF 0 180 2SDWAP D- [DCOS] MINUS 

12 ELSE ([DCOS] THEN ; 

13 

14 

15 


The fraction 20/7510 is a simplification of m/180/65 536 scaled by 10K. 
Do not reduce this to 2/751 or there will be a loss of accuracy. Most errors 
arise from the division in KN causing truncation and then the summing of a 
number of such errors. It may be possible to squeeze some improvement by 
multiplying the KN coefficients by 10 and using ROUND 10 / after the division. 
As it stands the crror is less than 2 in 10°. 

Since DCOS uses the ‘infinite’ series of (COS), the look-up table alternative 
may be preferred. This is based on the expansion: 


cos(A + B) = cos(A) cos(B) — sin(A) sin(B) 


If wc make A = degrees and B = minutes, then B is less than one degree and 
the following approximations may be used: cos(B)-~1 and sin(B)— B. 
Therefore we can say 


cos(A + B) = cos(A) — Bsin(A) 


where Bis in radians, hence the second definition of DCOS: 


0 ( DOUBLE NUMBER COSINE RDG-840927 ) 
{ 

2: DCOS ( D --- N /Gives COS * 10K for degs * 65536 *) 
5 DUP COS -ROT SIN OQ SWAP 

4 720 M*/ 31416 10000 M*/ 1 16384 M*¥/ DROP - ; 


The numbers in line 4 arise from the conversion of the angle in double 
degrees format to radians, i.e. 7/180/65 536. 

Both the sine and cosine series could be evaluated using the definitions 1+0X 
and 1+SX which are defined later for the arctan function. 


6.1.4 Quick and dirty methods 


Suppose we sum an infinite series to, say, 10 or 12 terms we may find that it 
involves terms that no longer contribute anything to accuracy, and yet can 
take a lot of unnecessary time. If the series is aborted after only a few terms a 
lot of accuracy is lost, but if the coefficients of the series are adjusted, we can 
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improve the accuracy without extensive computation. Normally SIN and COS 
functions are expressed in terms of Maclaurin’s series, but Chebyshev poly- 
nomials can be used to give a ‘best fit’ over a limited range of values. For 
sin(A ) where A is in degrees the following approximation may be used: 


, -_@4 4 
sin(A) — 3940 — 10800 
This expression is easy to implement in Forth and is simply: 


O ( SIN OF ANGLE BY CHEBYSHEV ROG-841103 ) 
2 10000 CONSTANT 10K 
3 
4 : SIN ( N1 -2- N2 /RETURN SIN®10K APPROX ®) 
5 DUP DUP Us 10K 10800 M*/ OMINUS 
6 ROT 1000 U* 630 3240 M*/ O+ DROP ; 
? 
8 
9 
}10 
; 
12 
13 
14 
15 


So what is the catch? Firstly, the expression is only valid for 0 < A <90 and 
secondly it is only correct at 0, 30 and 90 degrees. For intermediate vajues, 
the second digit may be out by one or two. Typical error figures are 


30<A< 90 less than 3.8% 
0<A< 30 approaching —11.4% as AO 


Another, more complex expression, called a rational polynomial approxima- 
tion, gives much better accuracy and requires the angle in radians: 


X— 7X*/60 


sin(X) = 
1+ X2/20 


and this too may be readily implemented in Forth by: 


SCR #130 

O ( SINCX] BY RATIONAL POLYNOMIAL RDG-841103 ) 
1 

2 10000 CONSTANT 10K 

3 

4 : SIN ( N1 --- N2 /RETURN SINE OF N1 RADIANS - N2 IS #10K *) 
§ 20000 OVER DUP U* 7 30 Ms/ «10K U/ 

6 SWAP S000 > + ( round ) - 

? OVER DUP Ue 110 Me/ 10K U/ 
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8 SWAP 5000 > + ( round ) 20000 + 
9 0 -ROT ( make N double ) M*/ DROP ; 


12 
se 
14 
1 


This version has been scaled to reduce loss of accuracy by truncation and to 
avoid resorting to triple-precision division and other complexitics. The out- 
come is a word which gives a result within one digit of the values obtained 
using the algorithm with floating point arithmetic. The error is greatest at 90 
degrees (1.5708 radians) where the result 1s: 


19708. SEN 99 580K 


The expression 1s scaled by 20000 and _ X (radians) by 10 000. The expression 
10K U/ SWAP 5000 > + adds one (rounds) the quotient if the remainder is more 
than half the denominator (10000). This is rather naughty because it assumes 
that the true flag from the comparison will be +1 whereas in many systems It 
is —1. To be portable the + should be replaced by [F 1+ THEN in both occur- 
rences of the expression. Some factoring of the definition could be made, but 
little is gained in so doing tn this instance unless the factored definitions can 
be used in further expressions. 


6.2 INVERSE FUNCTIONS 


The series for inverse functions are somewhat more complex to evaluate and 
you may prefer to use a successive approximation technique, i.e. ‘trial and 
error’. The expression trial and error is used advisedly since errors will arise 
from the error in the expression to evaluate the sine/cosine/tangent of each 
trial, plus the difference between the final try and the actual submitted value 
before ‘calling it a day’. This is related to the smallest number that can be 
resolved. [n addition there may he computational errors. 


6.2.1 Arccos 
( ARCCOS BY SUCCESSIVE APPROXIMATION RDG-840930 ) 


0 

1 

2: ARCCOS (NN --- D /CONVERT TOS [O-10K] TO DEGREES * 68536 *) 
3 090 ROT O 90 ROT 23 0 

4 D0 >R 

5 2SWAP 1 2 Me/ 2SWAP 

6 2DUP DCOS R< 

7 >R 20VER- R> 

8 IF DMINUS THEN D+ R> 
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9 LOOP DROP 2SWAP DROP DROP ; 
10 


ARCCOS sets up two double-precision numbers on the stack, both equivalent to 
90 degrees with N manipulated to the top. The DO...LOOP 1s then set up for 
23 iterations. Line 5 divides the second double number by two. This is then 
added 10 or subtracted from the top double number depending on whether 
the top item produces a DCOS value which is too high or low. The flag for this 
comparison ts stored on the return stack at line 7 and line 8 decides whcther 
to add or subtract the second double number. On leaving the LOOP the stack ts 
then tidied to leave the result. 

The routine requires DCOS to be defined first, which goes against the previ- 
ously defined objectives. It is also slow because of 0COS in the loop, and there 
are errors due to M*/ always rounding down through the closing iterations. 
Don't be alarmed by all these errors; they are not huge, and the accuracy may 
be sufficient. You may wonder why therc are 23 iterations through the loop. 
why not 32? Since the largest number is 90 degrees (1.e. 90 X 65536) after 23 
right-shifts (128 X 65 536), there is nothing left! Finally, as before. OMINUS 
may need to be replaced by DNEGATE. 


6.2.2  Arctan 
The series to evaluate arctan (X) is given by: 


3 ‘ ‘7 

arctan (X) = x-4 +4 = 4 oR 
and ts the one used in the next example. However, as an infinite series, it has a 
serious limitation in that it is slow to converge. 

For this reason ATN has been arranged to compute as many terms as are 
required with a limit of 50. This can be raised as desired if you don't mind 
waiting for the answer. In fact for X > | the series does not converge at all! 

As an example of this shortcoming, arctan (0.5) = 0.46365 and 5000 ATN 
leaves 4637 after summing 6 terms. 9000 ATN requires 26 terms to give 7328, 
but 9600 ATN requires SO terms and 10000 ATN requires well over SOQ terms. 
Above this, forget it, you're heading towards infinity and integer arithmetic 
cannot cope! It is included here as an academic exercise. 


0 ( ATN BY SERJES RDG-840916 ) 
1 

2 O VARIABLE (ATN) 

3 

46 : ATN ( N1 --- N2 /CONVERT STK TOP TO ANGLE IN RADIANS *) 
5 (ATN) ! DUP DUP 10K #/ XS! ( save xf2) 1 ( coefft ) 

6 51.100 OVER OVER / DUP CATN) +! O= IF LEAVE THEN 

? SWAP XS a 10K */ SWAP 

8 DUP ABS 2+ SWAP MINUS ¢- 

9 LOOP DROP DROP (ATN) a ;: 


ATN uses the variable (ATN) to accumulate terms in the series until either the 
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next term is insignificant or 50 terms have been summed. The manipulations 
in line 8 are to cause each Successive term to alternate in sign. 

ATN uses VARIABLE and MINUS which have been mentioned earlier, but LEAVE 
may act differently in more recent Forth standards. It should have little effect 
on ATN’s operation. 


6.2.3 Arcton by successive approximation 


The problem here is that the method requires TAN which must be defined, 
cither in terms of SIN and (0S, or as a series. Since the philosophy of this 
chapter is to have each function as a stand alone item, to use both sine and 
cosine functions is inadmissible. If TAN 1s to be defined using a Series simply to 
obtain the arctangent then we might as well use an appropriate series for arc- 
tan directly. 


6.2.4 Arctan by rational polynomial approximation 


Another expression which approximates to arctan(X) is the rational poly- 
nomial (Pade approximation) thus: 


7 v3 4 64 ys 
X+o xX +945 X 


10 yr, 5) ya 
l+9 AX +57 X 


arctan (X)= 


where again X< 1. To implement this using Forth’s integer arithmetic, we 
must again scale and factorize the expression. 


SCR #127 

O € ARCTAN BY RATIONAL FRACTION RDG-841202 ) 
1 

2: SPICK 6 SPO +a; ( 'Cos I don't have PICK ) 

3 

4 3 140K ( X D1 N1 N2 --- X D2 /CALCULATE NEXT TERM *) 
5 Me/ 10K 0 D+ 3PICK 10K Me/ ; 

6 

GctoltSK ( X 01 NI N2 --- N3 /CALCULATE FINAL TERM &) 
8 Me / 10K 0 0+ DROP SWAP DROP ; 

9 

10 : ATN ( N1 ~-- N2 /RETURN ARCTAN * 10K “1 <¢X ¢ 61 2) 
11 DUP DUP M* 10K M/ SWAP DROP DUP S->D 

ie 3PICK 3PICK 3PICK 3 14 14DX 10 9 14SX 

13 >R 64 735 14DX 7.9.14SX Me R> M/ SWAP DROP ; 

14 

13 


Accuracy 1s surprisingly good considering the ‘swap drops’ and the number of 
divisions. The error in the equation is greatest when X = 1 and increases at 
lower values for the calculation in Forth. Table 6.1 gives some sample figures. 
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Table 6.8 Accuracy of arctan figures obtained from rational polynomial 
approximation. 


x arctan equation Forth approx. error 
10000 0.785 398 7855.86 7855 013% 
8423 0.700007 7000.53 7000 001% 
6842 (0.600043 6000.51 6000 007% 
3094 0.300058 3000.58 3000 019% 


The figures are the same for positive or negative values and the greatest error 
is some 0.013%. The problem is knowing how accurate the ‘correct’ figures 
are: they come from a computer using floating point calculation of another 
approximation to find ATN(X)! 


6.2.5 Arcsin 


The usual series for arcsin is derived from an integrated binomial expansion of 
the first derivative, but then you already knew that, didn't you? In short the 
series runs thus: 


arcsin(X) = Xt 4x34 3 ¥5 4 Py tM 


gt + ag + at + Ts +: 


which can be factored out to repeated sum and product terms so that we can 
reuse the definitions for ATN, but with different coefficients. Like a lot of infi- 
nite series, the end result is only accurate for an infinite number of terms. 
Happily in practice a lesser number of terms can be used with some sacrifice 
in precision. With arcsin( X) sufficient accuracy may be obtained using only 
the first four terms above, although five are included in ARCSIN as defined. 


SCR #124 

O ( ARCSIN BY SERIES ROG-841202 ) 
1 

2: 3SPICK 6 SPd +a ; 

3 

4 : 140X ( X DI N1 N2 --- X 02 /CALCULATE NEXT TERM w) 
5 Me/ 10K 0 D+ 3PICK 10K Me/ 

6 

7: 148X ( X D1 N1 N2 --- N3 /CALCULATE FINAL TERM ) 
8 Mx / 10K 0 0+ DROP SWAP DROP j; 

9 

10 : ARCSIN ( N1 --- N2 /RETURN ARCSIN » 10K -1<«¢X ¢ 41 *) 
11 DUP DUP M* 10K M/ SWAP DROP DUP S->D 

12 8757 17280 1+0x 600 10008 1+0X 18 40 140X 1 6 1+8X 
13 Mx 10K M/ SWAP DROP ; 

14 


15 
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The fifth term has little effect if X is small, but as X approaches 1 (10000 
when scaled), the series converges more slowly and the extra term may be 


considered useful. The degree of accuracy obtained 1s shown in Table 6.2. 


Table 6.2. Accuracy of arctan figures obtained by series. 


X arctan series Forth error 
1.0000 1.570796 1.24616 12461 20% 
0.9000 1.119769 1.06794 10678 5.18% 
0.8000 0.927295 0.910852 | 9108 1.76% 
0.7000 0.775 398 0.770142 ’ 7700 0.67% 
0.6000 0.643501 0.641958 6419 0.25% 
0.5000 0.523599 0.523212 5 232 


If greater accuracy is required as X approaches | perhaps the method of look- 
up table should be used, especially since the Nth term becomes increasingly 
difficult to determine. Alternatively one could ‘adjust’ the coefficients of the 
higher order terms. 


6.3 POWERS 


It is not difficult to write a routine to raise a number X to a power N. One 
simply multiplies X by X for N— 1 times. The following definition *#* does just 
that, but filters out the special cases where N is one or zero. Negative values 
are not catered for. 


SCR #122 

O ( #e - PERFORM X*N BY REPEATED MULTIPLICATION ROG-841117 ) 
, 

2: ke ( X N --- XTN /RAISE X TO POWER N - N POSITIVE t ) 
3 DUP O= IF DROP DROP 1 

4 ELSE DUP 1 = 

5 IF DROP 

6 ELSE OVER SWAP 1 - 

? 0 DO OVER * LOOP 

a SWAP DROP 

9 THEN 

10 THEN ; 

11 

12 

13 

14 

15 


Line 3 handles the case where N=0 by clearing X and N from the stack and 
leaving the known result of 1. Lines 4 and 5 handle N= 1 by dropping Nand 
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leaving X. Line 6 sets up the parameters for a DO...LOOP to give the correct 
number of times to multiply by X. Line & then drops X to leave X*. 

This method can be rather limiting. Firstly X and N need only be fairly 
small before overflow occurs, e.g. 10° and 2'* are obviously near the limit. 
Secondly having multiplied X by X to get X squared, why not obtain X* by 
squaring X squared? By generating terms in X, X*, X*, X* and including 
them as required in the product according to the bit pattern of N when 
expressed in binary form, the number of multiplications is minimized [2]. 
Screen 120 shows the principle and D** is a double number version. Try 10” 
or 2°! for example. 


SCR 4120 

O ( X#*N - EXPONENTIATION ROG-841021 ) 
1 

2: 8e ( X N --- Xan /RAISE X TO POWER N *) 
3 >R 1 SWAP 

4 BEGIN R 1 AND IF SWAP OVER * SWAP THEN 

5 R> 2/ -ODUP 

6 WHILE >R OUP * 

7 REPEAT ROP ; 

8 

9 : Des ( N1 N2 --- D /RAISE X TO POWER N DOUBLE 4 RESULT *) 
10 >R 1, ROT 0 

11 BEGIN R 1 AND TF 2SWAP 20VER D* 2SWAP THEN 

12 R> 2/ -DUP 

13 WHILE >R 2DUP De 

14 REPEAT 2DROP ; 

15 


The definition of 2/ could readily be in code in applications where speed is 
important. R is the FigForth word to fetch the top number on the retum stack. 
This is called Rd in some Forths. The definition 0* multiplies two double- 
precision numbers and leaves a double-precision result. A suitable definition 
appears in Chapter 3. 


6.4 EXP(X) OR e* 


The conventional series for e* is an infinite series which is not a suitable 
choice to use in Forth. A shortened series for e* is given by: 


383 7 l 


a Y4 
384° 96° 24° 


e*= 1+ X+% 5X + 2X" + 
In Forth it can be realized by the following, where X and e” are both scaled by 


10000. 


SCR #129 
O ( EXPONENTIAL FUNCTION RDG-841103 ) 
1 
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2: 3PICK 6sPa+a ; 

3 

4: 1#DX ( X D1N1N2 --- X D2 /CALCULATE NEXT TERM *) 
5 Me/ 10K 0 D¢ 3PICK 10K Me/ ; 

6 

7: 14SX ( X D1.N1 N2 --- N3 /CALCULATE FINAL TERM ¢) 
8 Me/ 10K 0 D+ DROP SWAP DROP ; 

9 

10: EXP (N41 --- N2 /RETURN EXPONENTIAL® 10K -1 << X ¢ 4] ®) 
1 DUP = S->D 4 17:«14DX «17 4B 14DX «192 383 14py 

12 383 384 1+SX ; 

13 


16 ( EXPCX] = 1 4 383/384.X.01+192/383. X.01417/48.%. 0146/17, ¥39)} ») 


The definition of EXP is not unlike ATN in that it uses the same building blocks, 
but like ARCSIN is a lot simpler because only one polynomial is involved. The 
series 1s not infimite, but is an approximation valid for ABS(X) less than 1. See 
Table 6.3. 


Table 6.3 Values of c* 


X e* series Forth 
1.0000 2.718282 27 161.5 27 160 
0.1° 1.10517 11049.2 11048 
0 1.000 000 10000 10000 

—(),! 0.904 837 9050.88 9052 
—1.0000 0.367879 3671.88 3672 


For a treatment of logarithms in Forth see reference [3]. 


6.5 BINOMIALS 


The binomial series gives the value of numbers near to unity raised to a 
power. The form of the series suitable for expressing in Forth is: 


reat r en ( MD (14 Hii (14 xe» (_)})) 


where —-1 < X < +1. 


The behaviour of the series varies according to the value of k as X approaches 
its permissible limits. Generally accuracy deteriorates because the series fails 
to converge to a sensible value with a modest number of terms. If X 1s near to 
—1 the expression behaves bad]y with negative powers. 


SCR #131 
0 ( BINOMIAL FUNCTIONS 


——_ 


is a 


2 1/¢1#X). 5 


CN 
DUP 
“14 


( NI 
DUP 
-3.4 
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RDG-841103 | 


--- N2 /RETURN BINOMIAL*10K -1 < X ¢ #1) #) 
$->0 -7 10 14DX -5 8 14DX -1 2 140X 
1+DX 12 1+4SX ; 


--- N2 /RETURN BINOMIAL®10K -1 << X ¢< #1) &! 
$->D -9 10 14DX -?7 8 140X -5 6 1+#DX 
1+0X -1 2 148X ; 
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The polynomial is evaluated as before using the appropriate coefficients, the 
only difficulty being to find a suitable name for each word! See Tables 6.4(a) 
and (b). 


(a) 


(b) 


6.6 


Table 6.4 Behaviour of the binomial senes. 


(1+X)" Series Forth 
1.414214 1.42588 14258 
1.22475 1.22412 12249 
1.000 000 1.00000 10000 
0.707107 0.707642 7077 
0.500000 0.509472 5095 
1/(1+X)” series Forth 
0.707 10? 0.589811 5899 
0.814087 0.814087 8141 
1.000000 1.000000 10000 
2.000000 1.86269 18626 


SQUARE AND CUBE ROOTS 


Various methods exist to calculate the square root of a number, at least one of 
these being introduced in one’s schoo] days. However, some methods are 
more amenable to computer implementation than others, particularly where 
integer arithmetic ts concerned. 
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6.6.1 Square roots 


The first version here uses a successive approximation technique to produce a 
square root value of a 16-bit integer (actually 15-bits since it must be a posi- 
tive number). It uses the equation: 


ye (+4) 
2 


to give a second approximation X° to the square root of MN from a first 
approximation X. Mathematicians will recognize this equation as the Newton- 
Raphson method. The first approximation chosen in the example is purely 
arbitrary and the number of iterations used is adequate. No mathematical or 
scientific basis has been used to opitimize them except to test that they suffice. 


QO ( SQUARE ROOT 16-BIT ROG-840804 ) 


2 : APPROX ( N X --- N X* /COMPUTER NEXT APPROXIMATION +) 
3 OVER OVER / + 2/ j[ 

4 

5 : SQRT ( N1 --- N2 /RETURN SQUARE ROOT OF N [32767 MAX] #) 
6 60 50 DO APPROX LOOP SWAP DROP ; 

? 

8 : 3DUP ( N1 N2 N3 --- N1 N2 N3-N1 N2 N3 /DUP TOP 3 ITEMS” #) 


9 ( = 3 PICK 3 PICK 3 PICK ) 
10 >R OVER R SWAP >R OVER R> SWAP R> ; 


The number that we wish to find the square root of 1s often the result of the 
product of two numbers, for example the geometric mean. It follows therefore 
that it is likely to be a double number, hence DSQRT: 


0 ( SQUARE ROOT OF 32-BIT DOUBLE NUMBER RO0G-840804 ) 
1 

2: DSQRT ( D0 --- N /RETURN SQUARE ROOT OF DOUBLE NUMBER D * ) 
3 127, 70 DO 3DUP 

& M/MOD ROT DROP ROT O D+ 2 U/ 

5 SWAP DROP 

6 LOOP >R DROP DROP R> ; 

? 

8 

9 
10 
11 
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DSQRT works with the full 32-bit unsigned value. Since some implementations 
do not have PICK, the author’s included, it has been coded without. The defi- 
nition of 30UP is equivalent to 3 PICK 3 PICK 3 PICK and duplicates the top 
three stack items. 2DROP may be used instead of DROP DROP. ('83-standard has 
PICK and for this 3 should be 2.) 


6.6.2 Cube roots 


The process of finding the cube root ts similar to that used for square roots 
but the second approximation X” is given by: 


ie Gz + 2X) 
3 


Newton's method is in fact a general method for the Nth root of a number 
and this is the specific approximation for the cube root. Without a floating 
point arithmetic package, going beyond the cube root has little value (the 
fourth root of a double-precision integer can only have at best 3-digit resolu- 
tion). Even for the cube root it should be fairly obvious that if Nis only a 16- 
bit value, the cube root is less than 32 and is of only | or 2 significant figures, 
not a lot of use. Ideally, NM should be a tnple-precision number to yield a 
single-precision result. The more dedicated among you may be inclined to 
write a triple number version, but for the less ambitious the double number 
version will theoretically handle numbers up to 277°, but in practice this 
becomes 168° = 4787099 because of liberties taken in calculating X’. In 
particular, U* produces a double numbcr result which is not utilized. This ts to 
avoid performing a division with two double numbers. 

In CUBEROOT it has been attempted to optimize the number of iterations and 
the first guess. The optimum first guess is, of course, the correct result, but 
since this is unknown, a value has been chosen which is a compromise 
between | and 168. Jf CUBER0OT 1s to be used for a smaller range of results, 
then the first guess could be changed and the number of iterations reduced. 


Q ( CUBEROOT RDG-841029 | 
2: (CUBE) ( 0 N1 --- D N2 /DERIVE APPROXIMATION N2 FROM N1 +! 
3 JOUP DUP Us DROP ( hi ) M/MOD ROT DROP ( rem ) 

4 ROT 22 0 D# 3 U/ SWAP DROP ; 

§ 

6 : CUBEROOT ( UD --- N /LEAVE CUBE ROOT OF UD *) 
? 84 10000 (CUBE) LOOP 

8 SWAP DROP SWAP OROP ; 

9 

10 

14 

12 
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(CUBE) is the inner routine to derive a new approximation from the previous. 
30UP replicates the top three stack items, i.e. the double number and single- 
precision approximation, the remainder of the definition is the straightforward 
evaluation of the equation. 

CUBEROOT uses an initial guess of 84. Even if as a first guess this value is 
wildly out, 10 iterations are sufficient to handle the worst case. 


6.7 POLAR COORDINATES 


As an example of using the double-precision square root, conversion from 
cartesian to polar coordinates ts given by: 


Modulus R = ,/ (X’ + Y’) and argument § = arctan (Y/X) 


In Forth the modulus is simply defined by: 


: MODULUS ( N1 N2 --- N3 /Do SQRT of sum of squares + ) 
DUP Use ROT DUP U* b+ DSQART ; 


In MODULUS the expression DUP U* simply squares the top stack item each time 
and the two respective double-precision results are added before being 
presented to DSQRT. It 1s possible to extend the concept to calculate rms (root- 
mean-square) values for N items. If squares are likely to be commonplace in 
an application, then it will be worth factoring out DUP U* into a separate 
definition. It could then be included in the definition to find the area of a 
circle given the radius. As with any limited precision calculation, the radius 
may need to he scaled before the calculation is performed. The ratio 3$$/113 
is a close approximation to Tt. 


: AREA ( N --- D /GIVES AREA OF CIRCLE FROM RADIUS x) 
DUP U* 355 113 Me/ ; 


6.8 MODVARIABLE 


The range of values of a variable can be constrained using the word MOD as, for 
example, when an index to an array is to be constrained to the array limits. If 
several arrays or memory segments are to be indexed, it can be an advantage 
to define a family of such words. MODVAR is a defining word which will do this. 


( MODVARIABLE RDG-840703 ) 


0 

1 

2: MODVAR ( N1 N2 --- /VARIES AS MOO(N2] + N1 *) 
3 ( N3 <name> --- N4 ) 

4 <BUILDS [COMPILE] LITERAL , 

5 CCOMPILE] LITERAL , 

6 DOES> DUP @ ROT SWAP MOD SWAP 2+ a + ; 

r 
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8 ( eg: 3 7? MODVAR INDEX ) 
9 


The action of MODVAR is to constrain the function so defined (INDEX in the 
example) such that N INDEX varies between 3 + (0 to 6) as N varies over (0 to 
6) + 7 K where K is an integer. You may wish to experiment with the action 
of replacing MOD in line 6 with <M0D> as defined earlier in Chapter 2. 

You may recall that <BUILDS is the FigForth equivalent of CREATE and deter- 
mines what compiling action will occur when words defined by MODVAR are 
compiled into the dictionary. MODVAR works by twice compiling the cfa of 
LITERAL followed by the top stack item during the <BUILOS action. When a 
word defined by MODVAR, such as INDEX, is executed it uses these two numbers 
at run time in accordance with the actions following DOES> to determine the 
resulting value left by INDEX, 


Projects 


|. What are the problems in producing a definition to evaluate log(X) in 
Forth? 

2. Write and test a definition for exp(X) scaled by 10000 using the 
approximation: 


N 
e* = (1+2) 


for —]1 < X < 1 where the integer N determines the accuracy. Take care 
when applying the scaling to avoid errors due to rounding or overflow. 
How does the resulting method compare with the version given in the 
text for speed and accuracy? 
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7 Calendar Functions 


7.1. JULIAN DATE 


Astronomers require a convenient calendar that covers long periods of time 
before and after the present day and which can also allow for the 11 days lost 
in changing from the Julian calendar to the present Gregonan calendar. The 
Julian day number is the number of days counted from 1 January 4713 BC 
since this was originally thought to be roughly when the world began. 

The program definition JULIAN leaves the Julian day as a double number, 
given the date in the new style (Gregorian) calendar. 


O ( JULIAN DATE FROM ASTROPHYSICAL J. SUPPL. V41/3 11/79 ) 
1 

2 : JULIAN ( DAY MONTH YEAR --- D /LEAVES JULIAN DATE AS DBLE &# *) 
5 >R DUP 9 + 12 / R+ 7 *e & / MINUS 

4 OVER9 - 72? / R+ 100 / 14 3 * & / - SWAP 

5 275 9 e/ 4 + S->0 1.721029 D+ 367 R> Me D+ ; 

6 
? 


( —.G. 5 11 1888 JULIAN D. 2410947 OK ) 
8 


MINUS should be replaced by NEGATE if necessary. The routine will cope with 
dates BC if they are input as negative and will go back to circa 4600 ac. Day 
one BC is entered as 31 12 —1 and is one day before 1 10000 (J = 1721060). 
Beware of placing too much reliance on negative years as discrepancies 
of a few days have been noted. For example the equation appears to give day 
one as 25 November —4713 and JULIAN fails at around 1 3 —4682. 

The definition of JULIAN uses the formula 


J = 1721089 + D + INT(367(0(M-2)/12+x)) 
+ INTCINT(365. 25(¥-x))-0. 75k) 


where 


x=] ifM=1 or 2 
k = 2 for the old style Julian calendar 
k = INT((Y-x)/100) for the new style Gregorian calendar. 


Both systems give the same Julian day number, but remember that JULIAN as 
defined here computes the equation based on the Gregorian calendar. And 


SZ 
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yes, the numbers in JULIAN (1.721029) and in J (1721 089) are supposed to 
be different. 


7.2 WHAT DAY IS IT2 


Several algorithms have been published to calculate the day of the week from 
the date for a limited range of years. Most of them appear to be some simpli- 
fication of an algorithm known as Zeller’s Congruence. Screens 137 to 139 
are for a program to print a calendar for the given month and year and 
screens 137 and 150 are for the day of the week. 

For the day of the week the date can be entered as the day number, month 
as the first three characters and the year in full, for any year in the Gregorian 
calendar system from AD] to the year 4902. Since the Gregorian calendar was 
not introduced until 15 October 1582, before this you will need to make a 
correction. Years less than one are inadmissible. 


SCR 4137 

0 ( CALENDAR - 1 OF 3 ROG-821022 ) 
; 

2 : DATA <BUILDS , , DOES» OUP a SWAP 249 ; 

3° 31 +1 ~DATA JAN 28 2 DATA FEB 31. 3 DATA MAR 

4 30 4 DATA APR 31 5 DATA MAY 30 6 DATA JUN 

5 31 7 DATA JUL 31 8 DATA AUG 30 9 DATA SEP 

6 31 10 DATA OCT 30 11 DATA NOV 31 12 DATA DEC 

7 

8 : ->DAYS ( MO YR --- D /CONVERT TO DAYS SINCE JAN OF YR O * ) 
9 OVER OVER 365 Me ROT 1- 31 M® D+ >R OR SWAP DUP 3 «< 

10 1F DROP 1- O ELSE 4* 23 + #10 / MINUS TREN 

11 SWAP DUP 4& / SWAP 100 / 

12 14 34 */ - + Q R> R> De ; 

13 

14 

15 
SCR #150 

QO ( DAY OF THE WEEK RDG-821220 ) 
1 

2:00 ." SATURDAY" ; : 01 ." SUNDAY" 

3: D2  ." MONDAY” ; : D3 ." TUESDAY" 

4 : D4 .' WEDNESDAY" ; : 05 ." THURSDAY" 

5 : 06 ." FRIDAY" ; 

6 

7: .DAYN ( --- /PFA IS A LIST OF CFAS TO PRINT DAY *) 
8 D0 D1 D203 D4 DS D6 ; 

9 

10 : DAY? (¢ N --- /PRINT DAY FROM DAY NUMBER ») 
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11 ' DAYN SWAP 2.4 + Q EXECUTE ; 

12 

13: DAYOWEEK ( DD <mth> YYYY --- /PRINT DAY OF WEEK FROM DATA *) 
14 SWAP DROP ->DAYS ROT O D+ 7 M/MOD DROP DROP 

15 shIS A DAY? CR ; 


Here ts an example of its usc: 


1 JAN 1985 DAYOWEEK IS A TUESDAY 
OK 


The program uses a variation of Zeller’s congruence to calculate the number 
of days elapsed since year dot. Zeller's expression involves some clever foot- 
work to account for leap years and their occasional absence at the turn of 
certain, but not all centuries. To keep the arithmetic simple, two expressions 
are uscd: 


Days = 365(YYYY) + DD + 31(MM-1) - INTCO.4@MM + 2.3) + INTC(YYYY/4) 
- INTC3/4CINTCYYYY/100)41)) 


for March to December or 


Days = 365(YYYY) + DD + 31(MM-1) + INTCCYYYY-1)/4) - 
INTOC3/4C INTC CCYYYY-1)/100) # 1))) 


for January to February. 

‘These expressions are evaluated as a double-precision number by ->DAYS 
and M/M0D converts them to a number modulo 7 for the day of the week. The 
parameter field of . DAYN contains a list of cfas which are addresses of words to 
print each day of the week. DAY? uses the stack value !eft by the remainder 
from M/MOD as an index to the list, fetches the indexed cfa and executes it. 
Note that the word ' (tick) must return the pfa of . DAYN because it may differ 
in some dialects of Forth. 

To enable the month to be entered as text, a defining word DATA ts defined 
which will create a new family of words whose characteristics are similar to a 
double-precision constant. When the month is called by name, 1t returns its 
month number and last day. The last day 1s discarded by DAYOWEEK but is used 
in CALENDAR which follows. 


7.3> CALENDAR 


The calendar definition is called by name of month and year, for example NOV 
1888 CALENDAR will result in the calendar for that month being displayed on the 
terminal. 


SCR #138 

0 ( CALENDAR - 2 OF 3 RDG-821022 ) 
1 

2 : HEADER ( --- /PRINT THE HEADER *) 


5 CR CR." SUN MON TUE WED THU FRI SAT” 
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CR SPACE 270 00 45 EMIT LOOP ; 


4 
5 
6 : ISTDAY ( N1N2 -2- N3 /MTH YR TO DAY OF WEEK, 0 = SUNDAY *) 
? ->DAYS 7 M/MOD DROP DROP ; 

8 


9 : WEEK1 ( N --- N+? /FORMAT 1 WEEK TF N RANGES 1 TO MTH.END *) 


10 CR 70 00 OUP 1 < 

11 IF 4 SPACES 

12 ELSE SPACE DUP 10 < 

13 IF SPACE THEN DUP MTH.END a > 

14 IF 4 SPACES ELSE OUP. THEN 

1 THEN 1+* LOOP ; min 

SCR #139 

0 ( CALENDAR - 3 OF 3 RDG-821022 ) 


2: 2LEAP ( N --- /MAKE MTH.END = 29 IF N = LEAP YEAR * ) 
3 DUP 0 4 M/ DROP O= 

4 Lr DUP QO 400 M/ DROP O= 

5 IF 29 MTH.END ! 

6 ELSE DUP 0 100 M/ DROP O= O= 

7 IF 29 MTH.END ! THEN 

8 


THEN 
9 THEN ; 
10 
11: CALENDAR ( <mth> N --- /CALENDAR FROM 3 CHAR MONTH & YYYY ®) 
12 SWAP DUP MTH.END ! 28 = IF LEAP THEN 
13 HEADER 1STDAY DUP MINUS 1+ 
14 SWAP MTH.ENDaQ + 6 + 7 / 
1§ 0 00 WEEK1 LOOP DROP CR CR CR ; 


NEGATE should be used instead of MINUS in '79-standard or later. An cxample 
format is shown for February 2000 which occurs in a leap year. 


FEB 2000 CALENDAR 


SUN MON TUE WED THU FRI SAT 


13.14 18 16 17 18 «19 
20 2h) 22) 23. 26-.25° 26 
2? 28 29 


Note that a year is a leap year if it is divisible exactly by 4, or 400, but not if 
by 100 (or 40007). This complex correction factor is to make a calendar year 
equal to 365.2425 days. A year is defined as the time of one earth orbit round 
the sun and a day to be one rotation of the earth about its axis. The ratio of 
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these two, i.e. the number of days in a year, is 365.2422 ..., an irrational 
number, the value of which is also complicated by other factors, not to mention 
the earth’s rotation very gradually slowing down! 


Project 


Investigate the limitations of the JULIAN definition for BC dates. Determine at 
what future date JULIAN will fail. 


8 Factors and Multiples 


8.1 FACTORS 


Much fun was had playing with the factors routine, for example the highest 
prime number that the author could find was 32749, whereas 32738 = 2 X 


16369 and 30030 is the product of the first six primes. 


There are several methods for finding factors, the one here works by trial 


and error trying each prime in turn. Typical formats are: 


5600 FACTORS = 122 75 # 5 f2 97 
5601 FACTORS = 1 #3 # 1867 


The leading 1 serves to remind one that it is also a factor, but its real purpose 


is to avoid the difficulty of suppressing the leading +. 
O ( FACTORS - 1 OF 2 


RDG-840528 ) 


2: PRINT ( N1.N2 QUOT COUNT --- N1/N2 OR N1. /N1 IF COUNT=0 #) 
3 -puP If ROT ." *". ( N2) DUP 11> 

4 1F ." #" . ( Count ) ELSE DROP THEN DROP 

5 ELSE DROP DROP ( leave N1 ) 

6 THEN ; 

7 

8B : TOTHE ( N1 N2 --- N3 /LEAVES N1/N2 OR N1 IF NOT INTEGRAL #) 
9 0 BEGIN >R OVER OVER /MOD A> ROT 

10 ( N1 N2 quot count rem ) Q= 

11 WHILE 1% >R >R SWAP DROP R> SWAP R> 

12 REPEAT 

13 PRINT ; 

14 --> 

15 


( FACTORS - 2 OF 2 


0 

1 

2: CVECTOR ( N -- /Compile N bytes off stack 
3 <BUILDS 0 00 C, LOOP 

4 DOES> + Ca ; 

5 


RDG-840528 ) 


*) 
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6 31 29 23 19 17 1311 7? 8 CVECTOR TRIAL 

7? 

8 : FACTORS (-N --- /PRINTS OUT ANY FACTORS OF N 32767 MAX.  *#) 
9 me - | to 

10 2 TOTHE 3 TOTHE 5 TOTHE 

1] DUP 1 = [F CR DROP EXIT THEN 

12 buP 0 00 8 0 DO I TRIAL J + TOTHE LOOP 

13 OUP | < IF LEAVE THEN 30 

14 +LOOP DROP ; 

15 


The single dimension byte array TRIAL contains numbers which are not multi- 
ples of 2, 3 or S, t.e. the prime numbers from 7 up to 31. These numbers are 
used as trial divisors in TOTHE. Elowever, they do not all have to be prime and, 
in fact. the series is repeated with 30) added each time. This will result in 
occasional wasted trials, e.g. 30+ 19=49 may be tried, cven though 7 will 
have already climinated it as a factor. 

PRINT handles the format of the printed output and adjusts the stack 
parameters ready for the next trial. TOTHE extracts as many as possible of a 
given trial and raises the count uscd hy PRINT. CVECTOR creates a self-loading 
byte array and 1s used to create TRIAL which returns the byte indexed into the 
array. FACTORS then trics 2, 3 and 5 before using the trials in TRIAL. By success- 
ively adding 30, the numbcrs in TRIAL are reused until the trial is no longer 
less than the number to be factored. 


8.2. PRIME NUMBER GENERATION 


Now that you have a program to factorize numbers, how ahout some numbers 
that do not factorize? One of the classical methods of generating prime 
numbers is by using the Sieve of Eratosthenes [1], [2]. The first four numbers 
(), 1, 2, and 3 arc known to be primes and this ts assumed, together with the 
fact that all even numbers are not prime, neither are all multiples of primes. 
The program uses these facts to successively work through an array of flags. 
At line 8, for each position corresponding to ‘twice the current array index 
plus 3° the content is cleared from true to false. In addition, for each index, it 
clears other flags that cannot yield a prime. As can be imagined, if you want a 
lot of prime numbers, the array needs to be quite large. In the program shown 
a size of 1200 odd bytes yielded 2399 as the highest prime. Obviously if you 
have more memory at your disposal (and more time for program execution) 
then a greater number can be gencratcd. Using 8190 for SIZE will yield primes 
up to 16381. The word PRIME searches through the array and prints out the 
number corresponding to the array index if its flag is still set. 


0 ( SIEVE OF ERATOSTHENES - PRIME NUMBER PROGRAM. RDG-841006 ) 
1 1200 CONSTANT SIZE ( 2399 HIGHEST PRIME ) 
2 O VARIABLE FLAGS SI2€ ALLOT 


Se STEVE ( --- /SET STATE OF FLAGS IN ARRAY *) 
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4 FLAGS SIZE 1 FILL ( set array ) OQ (C count = Q) 
5 SIZE 0 DO FLAGS I + Ca 

é If 1 DUP + 3 + DUP I + 

? BEGIN DUP SIZE < 

8 WHILE O OVER FLAGS + C! OVER + 

9 REPEAT DROP DROP 1+ 


10 THEN 

i LOOP: tee PRIMES” 

1 

13: PRIMES ( --- /DO PRIME NUMBERS ACCORDING TQ ARRAY FLAGS t) 
14 CR SIZE 0 00 FLAGS I + Ca 

15 1f [ DUP + 3+ 5 .R THEN LOOP ; 


The action of SIEVE is sufficiently time consuming to form a useful benchmark 
program [2], although it is wise not to attach too much importance to bench- 
marks. 


8.2.1 Test for prime 


Sometimes it suffices to know that a number has no factors, 1.e. iS prime. 
Basically the technique puts a true flag on the stack and then looks for factors 
in N. If the search fails the number is prime and the true flag remains. If a 
factor is found, the flag is dropped and replaced by a false flag and then the 
search is terminated. 


: 2PRIME ( N --- /LEAVE TRUE FLAG IF N IS PRIME *) 
TRUE OVER 2 / 14+ 3 
00 OVER I MOD OQ= IF DROP FALSE LEAVE THEN 
LOOP SWAP DROP ; 


For '83-standard TRUE should be —1, for other standards +1 is more common. 
It should be the same as returned by the standard in use in the interests of 
consistency. 


8.3 HIGHEST COMMON FACTOR 


Given two numbers, the highest common factor is the greatest number that 
will divide exactly into both. On the American continent it 1s called the 
greatest common divisor (GCD). 


: HCF ( N1 N2 --- N3 /N3 IS HCF OF BOTH N1 & N2 *) 
BEGIN SWAP OVER MOD -DUP Q= UNTIL ; 


= (cHCF HCF CR." The HCF is". ; 


The HCF presented here performs three operations known as Fuclid’s algo- 
rithm and ts one of the earliest known algonthms, dating back as it does to 
c. 300 BC. The steps are: 
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1. Divide N1 by N2 and leave the remainder. 
2. If the remainder is zero leave with N2 as the answer. 
3. Replace N1 with N2, Ne with the remainder and go back to I. 


You should have little difficulty relating these steps to the program once you 
realize that step 3 !s performed first! In the example -DUP should be replaced by 
°DUP in later standards. 


84 LOWEST COMMON MULTIPLE 


Following naturally from HCF is LCM, and the lowest common multiple is given 
by: 


> LCM ( N1 N2 --- D0 /Leave lowest common multiple * ) 
>R 0 OVER R SWAP R> HCF Me/ 


: LCM ( N1 N2 --- /Print LCM t) 

LCM CRASS LEM Se Os 
The LCM is given simply by N1#N2/HCF, but since N1 and N2 could both be prime, 
the result could be a double numbcr. The definition above accommodates this 
possibility. 


8.5 FACTORIALS 


Factorials occur 1n many mathematical expressions, such as formulae for 
permutations and combinations. Factorial N grows large very rapidly with 
increasing N. 


: N! ( N --- N! /Compute factorial N - [8 max] *) 
1 SWAP 1+ 100 $I # LOOP ; 


The maximum permissible number ts 8 since 8! = 40320 but this can be 
increased by using double-precision arithmetic to leave a 32-bit result. 


- DN! ( U --- D /Compute factorial N leave double # ») 
1, ROT 1* 1 D0 1 UM* LOOP ; 


The double number version, ON! , will work with Nup to 12 before the result is 
too large. Both definitions return 1 for a negative number. UM* requires a 
double number with a single number on top and leaves a double number 
product. 

Factorials are an obvious candidate for recursion, or so we are told, but in 
Forth we can actually lose out due to the necessary stack manipulations. 
Recursive versions of the above require the previously mentioned word 
MYSELF which compiles the current definition’s compilation address into itself. 
In addition the double number version requires the version of UM* which 
multiplies a double number on the stack by a single-precision number on top. 
Line 9 corresponds to UM* and may be factored out if UM* is already defined. 
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SCR #136 

O (FACTORIAL-RECURSIVE VERSION ROG-841019 ) 
1 

2: MYSELF LATEST PFA CFA , ; IMMEDIATE 

3 

4 : FACT ( U1 --- U2 /RETURN FACTORIAL OF TOS VALUE *) 
” OUP 1 > IF DUP 1- MYSELF Us DROP THEN ; 

6 

7: DFACT ( U --- D /GIVES FACTORIAL OF TOS AS DOUBLE 4 *) 
8 OUP 1 > IF DUP ‘i- MYSELF ROT 

9 DUP ROT * -ROT Ue ROT + 

10 ELSE Q THEN ; 

11 

12 

13 

14 

15 


The recursive version puts on the stack N, N—1,...3, 2, 1 by successively 
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repeating DUP 1- until failing the ‘greater than one’ test. The ELSE branch 


converts the 1 on top to double-precision by capping it with a zero. The 


definition now unwinds by resuming with the words following MYSELF. ROT 
moves in turn each stack item over the double number, where line 9 (UN®) 
leaves a double product ready for the next item. Finally there is nothing left 


but the double-precision result. The limiting values are as before, but negative 


values behave differently. If U is negative, DFACT returns U 0, 1.e. U converted to 


double- precision. 


Project 


Redefine FACTORS ?PRIME and HCF to handle double-precision numbers. 


REFERENCES 


[1] Sept. 1981. BYTE Magazine, p180 
[2] Gilbreath, J. and Gilbreath, G. Jan. 1983, BYTE Magazine, p283 


9 When 10 Digits Are 
Not Enough 


The absence of floating point arithmetic is normally no disadvantage when 
Forth is appropriate to the task 1n hand. Even so, the ease with which Forth 
lends itself to many applications does sometimes result in an apparent 
requirement for floating point operation. In fact what may be required 1s 
simply extended arithmetic precision for certain calculations. The technique 1s 
to perform the calculation as you would long hand, but using Forth to do the 
spadework. For this Forth will need an accumulator or buffer to use for 
intermediate calculations and for the final result. 


9.1 LARGE FACTORIALS 


We saw in Chapter 8 how quickly factorials outstripped single- and double- 
precision calculations. By defining an accumulator as long as 1s required, we 
can store product terms without limit (memory permitting). In the example an 
accumulator of 200 digits enables factorials up to 120! to be calculated. On an 
average Forth system, the 158 digits of 100! took nearly 50 seconds to calcu- 
late and display. 


SCR #140 
0 ( LARGE FACTORIAL - 1 OF 3 RDG-841227 ) 


! C.ARRAY  <BUILDS ALLOT 
DOES> + ; 


SIZE C.ARRAY ! BUFF 


2 
3 
4 
5 200 CONSTANT SIZE (¢ 120! MAX ) 
6 
ie QO VARIABLE LAST 

8 
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SCR #141 

0 ( LARGE FACTORIAL - 2 OF 3 ROG-841227 | 
2: #N ( N --- /COMPUTE NEW PRODUCT IN ! BUFF *) 
3 0 (¢ initial carry ) LAST a 1+ 0 

4 00 OVER [ 'BUFF Ca * + ( times N, add carry ) 

5 10 /MOD SWAP I 'BUFF C! ( new carry ) 

6 LOOP 

7 BEGIN -DUP ( handle final carry ) 

8 WHILE 10 /MOD SWAP 1 LAST +! LAST @ DUP 14 

9 SIZE > IF «.” Overflow’ QUIT THEN 

10 'BUFF C! 

11 REPEAT DROP ; 

12 

13: SETUP ( --- /INITIALIZE FACTORIAL BUFFER AND POINTER *) 
14 10 !guFF Cc! (¢ SET BUFFER TO 1 ) 

15 Q LAST ! ? --> 

SCR #142 

0 ( LARGE FACTORIAL - 3 OF 3 RDG-841227 | 
1 

2° PACT ( --- /SHOW FACTORIAL IN !BUFF WITH COMMA PER K~ *) 
3 LAST a 1+ 0 

4 d0 LAST 9 1 - DUP 1+ 3 MOD O= 

5 I Q= O= AND IF 44 EMIT ( comma ) THEN 

6 'BUFF Cd 1 LR 

? LOOP cR ; 

8 

9 : FACT ( N --- /COMPUTE FACTORIAL IN ! BUFF * ) 
10 SETUP 1* 100 I *N LOOP ; 

11 

12 : N. FACTS ( N --- /OISPLAY ALL FACTORIALS UP TO N! t ) 
13 SETUP 1+ ‘1 

14 DO I *N CR.” FACTORIAL” 

5 13 .R ." =" .FACT LOOP CR ; 


Screen 140 defines a word to create a byte array and this is done in line 6 
where the factorial buffer ! BUFF is created. <BUILDS is a FigForth word and 
should be replaced by CREATE for '79 and later standards. The variable LAST 
points to the last product term in the buffer. The word #*N on screen 141 does 
most of the work. It multiplies the contents of ! BUFF by the number on the 
stack. This number should not exceed about 3200 (3200! requires a lot of 
memory) because the carry on some digits may exceed 32767. A fully imple- 
mented multiplication routine should be used to overcome this limitation. #*N 
uses a simple multiply and add sequence. The carry comes from the division 
by 10, the result of which may leave a carry greater than 10. The final carry is 
handled by the BEGIN/WHILE/REPEAT loop which extends the buffer by 
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as many digits as required. If this results in exceeding the length limit of the 
buffer, the calculation is abandoned by QUIT following the error message. 
Otherwise -DUP (or ?DUP ) generates a true condition, the buffer is extended 
until the carry is reduced by division to zero whereupon the loop terminates. 

SETUP puts | in location 0 of the buffer and LAST is set to index to it. The 
factorial is calculated by FACT which repeatedly calls #N to accumulate the 
product terms. At any time . FACT can be called to print the buffer contents. It 
does so from the high digit down, inserting a comma as required to partition 
each thousand by the words 3 M00 0= with 1 O= O= AND preventing a comma 
occurring al the end. 

Finally, N. FACTS will print out all the factorials up to that on the stack, This 
Operation is made simple because .fACT prints out the buffer contents non- 
destructively. 


9.2 MULTIPLICATION 


If the numeric operation of multiplication is broken down into its step by step 
procedure, as if one were doing it by hand, then no number ts involved which 
is too jarge for integer arithmetic. It follows that if the two numbers are stored 
as a digit sequence itn a work area, then the individual digits mav be manipu- 
lated at will. As when using a slide rule (remember them?), in the program 
that follows no attempt has heen made to account for negative values. nor to 
handle decimal points. 


SCR #86 

O ( 'ENFINITE' PRECISION MULTIPLY - 1 OF 4 RDG-841228 ) 
1 

2: C. ARRAY <BUILOS ALLOT 

3 DOES> + 

4 

5 20 CONSTANT <LEN> 

6 <LEN> C. ARRAY BUFF 

7 <LEN> C. ARRAY BUFF 

8 <LEN> 1¢ C. ARRAY *BUFF ( PART PRODUCT ) 

9 <LEN> <LEN> ¢ C.ARRAY RESULT ( ACCUMULATOR ) 

10 

11: LEN ( ADOR --- N /LEAVE LENGTH OF STRING AT ADOR *) 
12 OUP DUP BEGIN Ca Q= O= ( NULL CHAR? ) 

13 WHILE 14 OUP ( NEXT ADDR ) 

14 REPEAT SWAP - ( PTR-BASE = LEN) ; 

15-5 

SCR #87 

O ( ‘INFINITE PRECISION MULTIPLY - 2 OF 4 RDG-841228 ) 
1 

2: ENTRY ( ADOR --- F /GET INPUT TEXT TO ADOR AS BINARY t ) 


3 PAD <LEN> 1 - EXPECT PAD LEN OVER C! COUNT 0 
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4 00 PAD I + Ca BASE a DIGIT 

5 IF OVER I + C! ( STORE DIGIT ) 

6 ELSE OROP 0 ( LEAVE FF ) LEAVE THEN 

7 LOOP ; 

8 

9 : SUM ( N --- /ADD *BUFF * BASE#4N TO RESULT *) 
10 0 ( CARRY ) Q RESULT Cd QO *BUFF Cd MIN OC LIMS ) 
11 00 OVER I + 1* REUSLT DUP Ca ( CONTENT ) ROT 

12 I 1* *BUFF Ca ( CONTENT ) + + 

13 BASE 3 /MOD SWAP ROT C! ( LEAVE CARRY ) 

14 LOOP SWAP 0Q *BUFF Ca + 0 RESULT C! -DUP 

15 1F 10 RESULT +! O RESULT Ca RESULT C! THEN ; --> 

SCR #88 

O ( 'INFINITE' PRECISION MULTIPLY - 3 OF 4 ROG-841228 ) 
' 

2 : PRODUCT ( N -°- /LEAVE IN ®BUFF NUMBER-IN-1BUFF * DIGIT N *) 
3 O ( CARRY ) OO #BuFF Cc! ( INIT ) QO 1BUFF Cad OQ 

4 D0 OVER QO 1BUFF Ca 1 - IBUFF Ca 

5 * 4 ( TIMES N, + CARRY ) 

6 BASE @ /MOD SWAP I 1+ ®BUFF C! 

7 LOOP SWAP DROP QO 1BUFF Cad O *BUFF C! -OUP 

8 If 10 «BUFF +! O *BUFF Cad *BUFF C! THEN > 

9 

10 : PROMPT ( =-- /PROMPT FOR TWO NUMBERS +) 
11 BEGIN CR.“ 1ST NUM ? ” 0 IBUFF ENTRY UNTIL 

12 BEGIN CR." 2ND NUM ? “ Q 2BUFF ENTRY UNTIL 

13 --> 

14 

15 
SCR #89 

O ( 'INFINITE' PRECISION MULTIPLY - 4 OF 4 RDG-841228 ) 
1 : INIT (¢ --- /INITIALIZE THE RESULT BUFFER *) 
M4 <LEN> <LEN> ¢ 1 - 1 RESULT OVER ERASE OQ RESULT C! ; 

5 

4 : TIMES ( --- /MULTIPLY 1BUFF & 2BUFF CONTENTS 

5 0 2BUFF Ca DUP 0 00 OUP I = 2BUFF Ca (¢ GET MULT ) 

6 -DUP IF PRODUCT I SUM THEN LOOP DROP ; 

7 

8 : .ANS (¢ ADDR --- /GET COUNT AT ADDR & PRINT DIGITS *) 
9 COUNT SWAP OVER O CR 
10 DO }3=6—fOVER IT - 3 MOD O= I O= O= AND IF 44 EMIT THEN 
11 DUP 1 - Ca I - OVER + 1- Ca 1.R 
12 LOOP DROP DROP ; 
13 
14: MULT ( --- /INPUT TWO NUMBERS, LEAVE RESULT IN BUFFER a) 
15 INIT PROMPT TIMES Q RESULT .ANS ; 
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C.ARRAY is a defining word to create and determine the action of the work 
areas required, At compile time it allots the specified amount of memory. At 
run time the stack value is used as an index to the buffer by adding its value to 
the base address. 

LEN is used by ENTRY to determine the length of the input string. It works by 
examining each character from the first until a zero is found. 

ENTRY accepts characters into PAD and converts from ASCII to numbers in 
the current basc using DIGIT. Conversion stops at zero or the first invalid 
character. A false flag is left if the conversion fails so that PROMPT can request a 
retry. Note that in Forth-’83 standard, EXPECT does not put a zero (required by 
LEN) at the end of the string, but leaves the character count in SPAN, 

PRODUCT multiplies the number 18UFF by the given digit and leaves the result 
in «BUFF. Since numbers are entered Most Significant Digit (MSD) first, and 
we require the LSDs aligned, the result is written to *BUFF Least Significant 
Digit first. 

SUM accumulates the contents of *BUFF in RESULT. The value of *BUFF can be 
offset by the stack value N to allow for the numeric significance of the number 
in *BUFF, .e. the number is multiplied by the current base to the power N. 

INIT initializes only the result buffer, the others are simply overwritten and 
the count updated accordingly. TIMES does the real work of multiplying the 
two numbcrs and .ANS simply prints the answer. MULT does the whole thing, 
prompting for input and displaying the answer. 


9.3 DIVISION 


The same technique used for multiplication can be applied to division. In this 
case marking the decimal place is of more value. The basis of the routine was 
published in COMPUTE! magazine [1] but was revised to output to a work- 
space called WKSPC in addition to the terminal device. 


SCR #125 

0 ( O/P AS FLPT, DIVISION OF TWO NUMBERS - 1 OF 2 RDG-840928 ) 
1 ( AFTER MG-AUG 1983 ) 
2 

3 QO VARIABLE WKSPC 15 ALLOT ( DEFINE A WORKSPACE ) 

7 

5S : FRESH ( --- /FILL BUFFER WITH SPACES *) 
6 WKSPC 16 OVER C! ( PUT COUNT IN 1ST POSITION ) 

7 COUNT ERASE ; 

8 

Se CC EMT ( C --- /QUTPUT CHARACTER TO WKSPC & TERMINAL *) 
10 DUP EMIT WKSPC DUP >R Cad 1+ DUP ARC! R> + C! ; 

11 

12-2 1T03 ( N1 N2 N3 --- N1 N3 N2 N3 /DUP TOS INTO 3RD POSN *) 
13 DUP ROT SWAP ; 

14 <--> 
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SCR #126 
0 ( O/P AS FLPT, DIVISION OF TWO NUMBERS - 2 of 2 RDG-840928 ) 


2: QUOT ( N1 N2 --- /COMPUTE & OUTPUT N1/N2 AS FLTPT +) 
3 1703 /MOD OQ <# 4S #> DUP WKSPC ! 2DUP TYPE 

4 WKSPC 1+ SWAP CMOVE 10 * SWAP 1703 46 C.EMIT ; 

5 

6 : REMAIN ( N11 N2 --- /OUTPUT NEXT DIGIT OF REMAINDER * ) 
? /MOD 48 + C.EMIT 10 * SWAP 1703 ; 

8 

9 & PP Ls ( NUM DENOM --- /QUTPUT 10 DIGITS OF REMAINDER 4) 
10 DECIMAL FRESK QUOT 

11 10 0 00 REMAIN LOOP DROP DROP DROP ; 

12 

13 

14 

1§ 


WKSPC is a buffer created by a FigForth definition. Other standards may use 
CREATE WKSPC 17 ALLOT as an equivalent. 

FRESH clears the buffer ready for use. C, EMIT outputs the character on the 
stack to the terminal and additionally stores it in WKSPC. 1103 is a factored 
definition to rearrange the stack contents. QUOT handles the whole number 
portion of the result and REMAIN is called for each digit of the fractional part. 
FP/. does the work of getting it all together. 

The three routines given for multiplication, division and factorials have 
come together in this chapter from three different thought directions. As a 
result they do not form a neat set of definitions, they are not very good Forth 
and they have plenty of room for improvement. They have been left in the 
raw state in order to illustrate what improvements should be made and to save 
the author from having to rewnte them all! Now for the critique: 


1. Each routine has its own dedicated sets of working space, when in prac- 
lice they could share that of, for example, the multiplication routine. It 
follows that the three different initialization words could be commoned 
and 4N and PRODUCT become the same thing and . FACT and . ANS are essen- 
tially the same. 

2. The multiplication and division routines keep a count of the numeric 
string length, whereas the factorial uses pointers. 


3. Multiplication uses the numeric equivalent of each digit, whereas division 
uses ASCII characters. 

4. The use of dedicated buffers prevents the routines from being used to 
process numbers in other parts of a system without having to move them 
first. 

5. In the multiplication routine, TIMES does not perform the product and 
sum if the digit in question is zero, but if the digit is one, the product is 
superfluous and only the sum need be performed. 
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6. The multiplication routine will work with any reasonable base and this 
facility could readily be incorporated in the other two. In which case one 
should consider factoring out BASE @ /M00 SWAP as a separate definition. 


7. The choice of names could be improved as part of the tidying up process. 
The above points illustrate a Forth programming rule: ‘write the general, not 
the specific’. Each routine described came from a different application and 
was specifically tailored to that application, whereas had they been written in 


a more general form they would not have come together as such complete 
Strangers. 


Project 


Respond to the above critique. From the examples in this chapter create a 
revised set of definitions to handle ‘unlimited’ precision arithmetic in the 
current base. 


REFERENCES 
[1] Ganis, M. August 1983. ‘Floating Point Division’ COMPUTE! p249 
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10.1 SORT AND SEARCH 


The subjects of search and sorting are sufficiently large to warrant a text of 
their own [1]. Few routines of this nature have appeared written in Forth. 
Numbers may be sorted recursively on the stack [2]. but this precludes using 
the stack for anything else during the sort. The standard quicksort routine has 
been implemented in Forth [3] and it is included here primarily because the 
search routine chosen requires a sorted list! One search and one sort have 
been selected by way of example. 


10.1.1 Quicksort routine 


The quicksort technique is to divide the array into two and compare the 
middle value with each item in the lower end of the array until a value greater 
than the mid-value is found. The high end of the array is then searched from 
the end downwards for a value less than the mid-value. These (wo numbers 
are then swapped. The process continues until the middle is reached. At this 
point we have an array of values less than the mid-value and another of values 
greater than the mid-value. The process is repeated on the two arrays and 
again on the four arrays, continuing until an array fragment is so small it is 
only one item long. With only one item 1t no longer requires sorting. The pro- 
cess is complete when all pieces have been sorted. 


OQ ¢( QUICK SORT - SORTS BYTE ARRAY - 4TH DIM V/S P29 MP-840100 ) 
1 
2 0 VARIABLE MIDDLE 


3: EXCHANGE ( ADDR1 ADDR2 --- /SWAP BYTES AT ADOR! & ADDR2 +) 
4 20UP Ca SWAP CQ ROT C! SWAP C! ; 

5 

6 : SORT ( START. ADOR END. ADDR --- /SORTS BYTE ARRAY *) 
? 2DUP 2DUP OVER - 2/ + Ca MIDDLE ! ( pick middle one ) 
8 BEGIN SWAP BEGIN DUP Ca MIDDLE a < WHILE 1¢ REPEAT 

9 SWAP BEGIN DUP Ca MIDDLE a > WHILE 1- REPEAT 
10 2DUP > O= IF 2DUP EXCHANGE 1 -1 D+ THEN 

11 2DUP > ( until partitions cross ) 
12 UNTIL SWAP ROT ( sort both pieces ) 
13 COVER 2OVER - -ROT - < IF 2SWAP THEN 
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14 2DUP < IF MYSELF ELSE 2DROP THEN 
1§ 2DUP < IF MYSELF ELSE 2DROP THEN ; 


EXCHANGE is similar to VSWAP but operates on bytes, not 16-bit values. Lines 7 
to 11 perform one dividing pass and leave four addresses on the stack repre- 
senting the ends of the two smaller arrays. Lines 12 and 13 arrange that the 
smaller of the two arrays ts sorted first to prevent the recursion from going too 
deeply. Finally, lines 14 and 15 of the sort repeat the process on both arrays 
by recalling SORT until! done. The action can be seen pictorially on computers 
using memory-mapped video. 


10.1.2 Binary search 


The binary search is similar in operation to the sort and 1s a fast way of look- 
ing for a given value in a sorted array. Again the middle element is selected. If 
this is larger than the desired value, then the upper haif of the array is ignored, 
otherwise the lower half is ignored by simply adjusting the array pointers. As 
can be guessed the halving process is continued until either the required value 
is found, or the pointers cross paths. In the latter case the search has failed. 
Note that to search a 4000 element array any item can be found or deter- 
mined to be absent by examining only 12 elements. An element can be a byte, 
cell or 32-bit double-precision value without affecting the number of 
Operations. 


SCR #79 
0 ( BINARY SEARCH ROUTINE RDG-841230 ) 
1 0 VARIABLE LOWER 0 VARIABLE UPPER 
2 0 CONSTANT FALSE 0. = CONSTANT TRUE 
3 
4 : SEEK ( VLU --- .N F /SEARCH FOR V BTWN LOWER & UPPER ADOR *) 
5 UPPER | LOWER ! 

6 BEGIN LOWER 2 UPPER @ 2DUP > DUP OR 
? IF DROP 
8 ELSE O SWAPO D+ 2 U/ SWAP DROP 
9 2DUuP Ca 2buUP = 

10 THEN R> SWAP OVER OR O= 

r WHILE DROP > IF 14 LOWER ! 

12 ELSE 1- UPPER ! THEN 

13 REPEAT IF FALSE 

16 ELSE 2DROP SWAP DROP TRUE THEN ; 


SEEK requires on the stack the value sought, the lower address and on top the 
upper address. The variables LOWER and UPPER are pointers to the array and are 
initially set to the end points of the array. Line 8 calculates the mid-point, and 
9 tests the byte for equality with the sought value. Lines 11 and 12 move the 
end pointers to their new positions and if or when found, lines 13 and 14 tidy 
the stack and leave a condition flag. TRUE is defined to leave a true value 
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appropriate to the system in use. In other words this definition is portable to 
any Forth standard! 


10.2. EGYPTIAN AND RATIONAL FRACTIONS 


10.2.1 Egyptian fractions 


An Egyptian fraction is a fraction which has a numerator of 1 and is so named 
because the ancient Egyptians lacked practical methods for handling other 
types of fractions. A fraction whose value is less than | is known as a proper 
fraction and EFRAC is a definition which will partition a proper fraction into a 
sum of Egyptian fractions. It uses the Fibonacci maximal algorithm published 
in the year 1202 to do this. 

Suppose our fraction is A/B, we first need the largest Egyptian fraction 
which is less than A/B. The difference is taken and the process continued until 
the difference is zero. In practice a small number can give a fraction whose 
denominator will exceed 32767 and we then terminate the senes with an 
overflow message. It may be inconvenient in Forth to handle a ratio such as 
3/7 but using EFRAC we can see 


3/7 = 1/3 + 1/11 # 1/231 


EFRAC is rather complex to explain in words and reference should be made to 
the flowchart shown in Figure 10.!. 


SCR #143 
O € EGYPTIAN FRACTIONS RDG-841228 ) 


2 : EFRAC ( N1 N2 --= /PRINT THE EGYPTIAN FRACS = N1/N2 2) 
| OVER OVER < IF ." =" 

4 BEGIN OVER O= IF DROP DROP EXIT THEN OVER 1 > 

5 IF OVER OVER SWAP / 

6 BEGIN >R OVER R * OVER - R> OVER O< 

if WHILE SWAP DROP i+ 

8 REPEAT >R -ROT SWAP DROP R U* R> 


9 ELSE SWAP DROP Q SWAP OVER (0) OVER ( © ) 
10 THEN .«" #1 /" U, 

11 UNTIL ." # OVERFLOW” CR 

12 THEN DROP DROP ; 

13 

14 

15 


10.2.2 Rational fractions 


The handling of rational fractions in Forth has been comprehensively covered 
by Grossman [4] and will not be discussed in detail here. Rational fractions 
are useful in Forth's integer arithmetic for handling numbers such as fm or the 
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Y 
AC—B>0 ie 
- THEN 


Print “+ 1/" 
Print C 


REPEAT 
N 
UNTIL 


Print "o/f" 


Figure 10.1 Flowchart for EFRAC. 
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square root of two. The ratios are sufficiently accurate for single- precision, 
and are generally adequate for double-precision. Some cxamples are given 
below. 


180 _ 57.295 779 573078 = “008 


V2 = 1414213562373 = Snags 


V3 = 1.732050 807 5689 — 645 


10.3. MATRICES AND ARRAYS 


Matrices and arrays come in many shapes and sizcs and are added to Forth as 
requircd. Several examples have already appcared but three FigForth defini- 
tions are given here to illustrate the principles. In later standards <BUILDS 
should be replaced with CREATE. The first is a defining word which at compile 
time creates a header. At run time the 00£S> portion fetches the 16-bit 
contents of the array element addressed by the index on the stack. The 2*¢ 
was defined as code in Chapter 2 but 2 * + will suffice if speed 1s not impera- 
tive. 


: TABLE ( --- /Defines a look-up table of 16-bit elements 2) 
(Nl --- N2 /Return contents Ne of index NI ) 
<BUILDS 


ODOES> SWAP 2+ @ ; 


An example of usage might be as a look-up table where there may not be a 
simple algorithm to rclate the values. Alternatively, for speed, it may be 
preferred in complex calculations, such as sines and cosines. Rather than type 
out the wholc sine table the problem can he illustrated to perform cubes: 


TABLE CUBED OF, 1,8, 27, 81, 125 , 216 , (as required) 
CR 3 CUBED 
27 OK 


CMATRIX defines an array M by N, each element being a single byte. At run 
time the address is returned of the element m,n which can be used with Ca or 
C! to fetch or store a single byte. 


: CMATRIX ( MN --- /Matrix of 1-byte elements *) 
( MN --- addr /Return address of element m,n) 
<BUILDS 1+ SWAP 1# DUP , * ALLOT 
DOES> DUP 2+ oR Q *# 6 R> + > 


An example might he for a noughts and crosses game where one defincs: 
2 2 CMATRIX 3x3 


Note that the addressing of rows and columns goes from () to 2 for a 3 by 3 
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matrix. Consecutive addresses are given by 
OO3x3. 1 O SxS: 20 SKS: OO SKS 1 BXS es 2.2-3%3 


MATRIX is similar to CMATRIX but being twice the size returns alternate addresses 
to handle 16-bit cells. A definition such as this would be used for a 3 by 3 
matrix for use in graphics manipulations. 


: MATRIX ( MN --- /Matrix of 2-byte elements *) 
( MN --- addr /Return address of element m,n) 
<BUILDS 1+ SWAP 1+ DUP , 2* * ALLOT 
DOES> DUP 2+ >R g@ *# + 2# RD + | 


10.4 TOOLS 


It is axiomatic that several special purpose tools are better than one general 
purpose item. In Forth this ts especially so since each or all can reside in 
memory and may be called upon as required. In addition, being specialist they 
are often, but not always, simpler routines and can be written as required. 
Some simple examples are included here, but large applications require 
complex tools and these are best obtained via vendors. 

The first special tool here is PLIST which prints two consecutive screens side 
by side using a 163-column 12-pitch printer and thus allows six screens to be 
printed per page of 15+ inch listing paper. The words PRT-ON and PRT-OFF 
must have previously been defined to set and respectively restore printer 
output. 


0 ( PLIST - PRINTS 2 SEQ. SCREENS SIDE BY SIDE RDG-B30221 ) 
1 

2: PLIST ( SCRA --- /PRINT THIS SCREEN & NEXT ONE *) 
3 PRT-ON CR DUP SCR ! ." SCR A" & LR 

4 71 SPACES SCR g9 1+." SCR A" 4 LR 

5 16 0 00 CR I 3 .R SPACE I SCR a (LINE) TYPE 

6 12 SPACES 

7 I 3 .R SPACE 1 SCR ad 1* (LINE) TYPE 

| ?TERMINAL IF LEAVE THEN 

9 LOOP CR CR PRT-OFF ; 

10 

11 

12 

13 

14 

15 


The word (LINE) takes the line number and screen and converts it to an 
address and count ready for TYPE to output the line. The number of spaces (71 
and 12) may need fine tuning according to the exact number of columns avail- 
able on the printer. 
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10.4.1 Cross-reference 


It is a useful practice to terminate each line containing a colon definition with 
a comment marked with an asterisk in a consistent manner. By so doing it 
enables a simple utility to search the disk and print out all such definitions 
along with their block and line numbers. The cross-reference utility ts repro- 
duced below. 


O ( CROSS-REFERENCE, SEARCH FOR STAR-MARKED COMMENTS RDG-830519 ) 


2: CROSSREF (NI N2 --- / ..vseceeees SEARCH SCREEN RANGE FOR *) 
314 SWAP D0 (16.0 

4 DO FORTH I J (LINE) C/L = 

5 [IF 6244 10538 = 

6 IF CRJ&.R © 4.R I J .LINE THEN 
7 ELSE DROP 

g THEN 

9 LOOP 

10 LOOP CR ; 

11 

12 

13 \ LINE MUST END WITH #) IN COLUMNS 63,64 OF LINE. 

14 

15 


The 62 + modifies the address left by (LINE) from the first to the 63rd column 
in the buffer and if the contents equals 10538 then *) is present at the end of 
line. Note that 10538 = 42 + 256 X 41 where 42 = ASCII * and 41 = ASCII 
). The comment on line 13 must not be inside brackets since a closing bracket 
is required within the comment. 


10.4.2. Address information 


INFO pives details of the address parameters of a colon definition formatted as 
hexadecimal. Used in conjunction with DUMP it is useful for checking that 
compilation is as expected. INFO expects the name of a definition to follow it. 
It came originally, the author believes, from Paul Bartoldi, around 1981. 


0 ( INFO - GIVES NFA, LFA, CFA PFA & CONTENTS RDG-830519 ) 
! 
: AHAH (CN o2- /OUTPUTS TOS AS S$XXXX *) 
S->D <# A AN A 36 HOLD H> TYPE 2 SPACES ; 


2 

3 

4 

5 : INFO -FIND CR HEX ( GIVE PARAMETER DETAILS *) 
6 If DROP OUP NFA .“ NFA=" RHAK 

? DUP LFA ." LFA=" HAH 

8 OUP CFA .“ CRA=" WHAR 

9 OUP ~" PFA=" AHH CR 

0 
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11 DUP NFA.” a:" 3 AAAH 

12 DUP LFA." a:" @ AMM 

13 OUP CFA." a:" od AAA 

14 ~ as" @ AWRH CR 

15 ELSE ." CAN'T FIND IT! " CR THEN DECIMAL ; 


A typical format for the word #444 might be: 


INFO AMBH 

NFA=$3197 LFA=$319C CFA=$319E PFA=$31A0 
a :$2384 a:$3174 a:$0B8? a:$166F 
OK 


-FIND is FigForth and returns the parameter field address. FIND is almost the 
same but returns the code field address. In ths instance some minor adjust- 
ments (such as inserting 2+) will be required before use. 

Further examples of software tools can be found in references [5] and [6]. 


Project 


Write a short decompiler which will display the cfa in hexadecimal and the 
corresponding name for each word compiled into the parameter field of a 
colon definition. Use the form SHOW <name> for the definition and incorporate 
a check to ensure the word <name> to be decompiled is a colon definition and 
not some other form. Investigate the problems of extending the idea to cover 
other types of definition, e.g. vanables and constants. 


REFERENCES 


[1] Knuth, D.E. 1973. The Art of Computer Programming, Vol. 3, ‘Searching and 
Sorting’. Addison- Wesley. 

[2] Turpin, R.A. July/August 1983. ‘Recursive Sort on the Stack’ Forth Dimensions, 
V, No. 2 

[3] Perkcl, M. January/February 1984. ‘Quick Sort in Forth’ Forth Dimensions, V, 
No. 5S. 

[4] Grossman, N. ‘Long Divisors and Short Fractions’ Forth Dimensions, VI, No. 3, 
p10 

[5] Anderson, A. and Tracy, M. 1984. Mastering Forth. Bowie: Robert J. Bradic Co. 
[6] Feierbach, G. and Thomas, P. Forth Tools and Applications. 
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The glossary is an alphabetical list of the words defined in this book. 


' BUFF 
ARAA 
WH. 
H6 
$XX 
SXXXX 


&X 


(14x). 5 


(ATN) 
(COS) 


(CUBE ) 


(SIN) 


at 
*BUFF 
tN 
+MINS 


->> 
->DAYS 


-a 
“ROT 


~ ANS 


. DAYN 
FACT 


A buffer used for storing the result of the factorial generated by 
FACT. 

(n --- ) Outputs n formatted as $XXxx 

Converts two digits as based 60. used by . KMS 

A formatting word in #4. used by . HSS 

(--- n ) Leaves the hex value of the characters XX without 
changing the current base. 

(--- 1 ) Leaves the hex value of the characters XXXX without 
changing the current base. 

(--- n) Leaves the ASCII value of the character X. 

A particular form of the binomial series expansion. 

A variable used by ATN to accumulate terms in a series. 

(ni --- n2) Returns the cosine (scaled by 10000) of ni where 
n! is in radians in the range + 7/2 (also scaled by 10000). 
(dni --- dn2 ) Leaves a second approximation n2 from a first 
guess n1 of the cube root of double number c. 

(ni --- n2 ) Leaves sine (scaled by 10000) of given angle in 
radians (also scaled by 10000) for 0 to + n/2. 

(n1 n2 --- n3 ) Leavesn1 raised to power ne. 

A buffer used by MULT to store partial products. 

(n --- ) Multiples content of ! BUFF byn. Used by FACT 

(ul u2 --- d) Converts u1 degrees and u2 minutes of arc toa 
double number representing degrees times 65 536. 

When loading causes loading of next but one screen. 


(month year --- d ) Returns number of days since January of 
year 0. 

( addr --- n ) Leaves inverted contents of address. 

(n1 n2n3 --- n3 ni n2 ) Rotates top three stack items 


counter-clockwise. 

( addr --- ) Used by MULT to print out the contents of the RESULT 
buffer. 

Compiles.a list of cfas to print the day of the week. 

(--- ) Outputs the factorial in ! BUFF formatted with a comma 
separator every thousands digit. 
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_ HCF 
. HMS 
LCM 
.§ 

/at 
0<> 
14+DXx 


14+8X 
1/(1#X).5 
10K 

1BUF F 
ISTDAY 


1T03 
IVIA 
é! 
or 


one 
/ 
27 


2a 

2BUF F 
2cON 
2DROP 
2DUP 
2NUMS 
20VER 


2ROT 
2SWAP 
oVAR 
2VIA 
32a 
30UP 


3NUMS 
3PICK 


4H 
4PICK 


(ni n2 === ) Prints the highest common factor of n1 and n2. 

( ~-- ) Prints the time as KH. MM. SS 

(1 n2 --- ) Prints lowest common multiple of n1 and n2. 

Prints the stack contents non-destructively. 

(ul u2 --- u3 ) Returns u1 right shifted u2 times. 

(n --- f ) Returns true flag ifn is non-zero. 

A factored definition to evaluate the next term in a rational 
polynomial. 

Similar to 1+#0X but for the final term of the series. 

A particular form of the binomial series expansion. 

A constant defined = 10000 

First number input buffer used by MULT. 

(ni n2 --- 03) Converts month number n! and year n2 to day 
number of the week for CALENDAR. 

(nine n3 --- nl n3 n2n3 ) Used by FP/. to rearrange the stack. 
An address defined as a constant. 

(d addr --- ) Stores double number at address. 

(u --- u*2 ) Can be defined to double top stack item or perform 
arithmetic shift left (unsigned times two). 

( addr ni --- n2 ) A code definition which leaves address + 2#n 
for use with arrays. 

(u --- u/2 ) Acode definition to perform an arithmetic shift 
right. 

(u--- 2fu ) Returns the bit significance of the bit number, i.e. 2“ 
(range () to 15). 

( addr --- d ) Fetches double number from address. 

Second number input buffer used by MULT. 

Defines a 32-bit constant. 

(d --- ) Drops a double number. 

(d --- dd ) Duplicates a double number. 

(u --- ) Outputs u formatted as two digits. 

(d1 d2--- di d2 di ) Copies the second double number to the 
top of stack. 

(d1 d2d3 --- d2 d3d1 ) Does rotation with three double 
numbers. 

(d1d2 --- d2 d1 ) Swaps top two double numbers. 

Defines a double-precision variable. 

An address defined as a constant. 

( addr’ addr2 --- n ) Polls addresses 1 and 2 until a bit is set. 
Returns n as the bit number set in the range 0 to 15. 

(nt n2n3 --- ni n2n3n1 n2n3 ) Duplicates the top three stack 
items. 

(u --- ) Outputs u formatted as three digits. 

(n1 n2 n3 --- nl n2n3 n1 ) Copies third stack item to top. A 
substitute for 3 PICK. 

A format conversion word used by BITS. 

(nl ne n3n& --- ni n2n3 né ni) Copies fourth stack item to top. 


4 SWAP 
‘CODE \ 
jNEXT 
;POP 
<LEN> 


<MO0D> 
71B1T 


2E-W 
LEAP 
INAS 
?PRIME 
A-B/A+B 
ACR 
APPROX 
ARCCOS 
ARCSIN 
AREA 
ASCII 
ATN 


BEARING 


BET=CEF 
BIT-ON 


BIT-TOGGLE 


BLT? 
BITS 
BOUNDS 


oe 


C. ARRAY 
C. EMIT 
CALENDAR 
CJOIN 
CMATRIX 
COS 
CROSSREF 


CSPLIT 
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A substitute for 4 PICK. 
(nl n2n3n& --- n&é n3 n2 ni) Transposes top four stack items. 


Words used in pseudo assembler. 


A constant used by MULT. 


(1n1 n2 --- n3 ) Limits n1 to the range 1 to n2 inclusive. 
(n --- f ) Returns a flag which is true if one, and only one bit of n 
I$ Sel. 


(f --- ) Outputs W if true, otherwise E. 
(n --- ) Checks for leap year and used by CALENDAR. 


(f --- ) Outputs $ if true, otherwise N. 
(n --- ) Leaves a true flag ifn is prime. 
(nl n2 --- n3 ) Leaves the ratio of the difference and the sum of 


two numbers, scaled by 10000. 

Adds a fixed offset to a 6522 VIA chip base address to leave the 
Auxiliary Control Register address. 

(n1 n2 --- n1 13 :) Computes the next approximation n3 from the 
first guess n2 for the square root at n’. 

(n --- cd ) Returns the angle in degrees X 65536 format whose 
cosine 1s the given value (also scaled by 1NQ00). 

(n1 --- n2 ) Returns the angle in radians (scaled by 10.000) 
whose sine is the given value (also scaled by 10.000). 

(n --- d ) Returns the area of a circle from its radius. 

(<c> --- n ) Leaves the ASCII value of the next inline character. 
(ni --- n2 ) Returns the angle in radians (scaled by 10000) 
whose tangents the given value (also scaled by 10000). 
Returns the bearing in degrees X 65536 from the latitudes and 
longitudes of two points. 

(c addr -=- ) Turns off bit c at address. 


(¢ addr --- ) Turns on bitc at address. 

( ¢ addr --- ) Toggles bit c at address. 

(c addr --- f ) Leaves the status of bit of given address. 

(n --- ) Printso in binary, formatted in blocks of four bits. 

(addr n --- addr+n addr ) Returns loop start and end values from 
start address and count. 

(¢ --- ) Stores a byte in an area which operates as a push-down 
stack. 


Defines a byte array. 

(c --- ) Used by FP/. to output a character. 

Prints a calendar given the name of the month and year. 

(hi lo --- n ) Joins two bytes as one cell. 

Detines a matrix of 1-byte elements. 

(ni --- n2 ) Returns cosine of n1 degrees (scaled by 10000). 
(ni n2 --- ) Searches the range of screens specified and prints 
lines ending in *). 

(n --- hi lo) Sphts the top stack item as high and tow bytes. 
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CSWAP 
CTRL-X 
CUBED 
CUBEROOT 


CVECTOR 
De 
Dos 


Do- 
0- 
D->§ 


0/24 

00 to 06 
o0< 

00= 

Des 

D< 


p= 
)> 


DATA 


DAY? 
DAYOWEEK 


dCOS 
DDRA 


DORB 
DEPTH 
DFACT 
DMAX 
DMIN 
ON! 
DSQRT 
DU< 


EFRAC 
ENTRY 


EXCHANGE 
EXIT 


(ni --- n2 ) Interchanges high and low bytes of top stack item. 
(--- n ) Leaves the ASCT] value for the control character X. 

A table which returns the value of the index cubed. 

(ud --- n ) Leaves the cube root of the unsigned 
double-precision number ud. 

A defining word to compile n bytes off the stack. At run time 
returns the byte indexed. 


(d1 d2 --- d3 ) Leaves double- precision product of two 
double-precision numbers. 

(nine --- d ) Leaves n1 raised to power n2 as a double- precision 
number. 


(din --- d2 ) Leaves d1 with the sign of n. 

(d1d2 --- d3 ) Leaves the difference of two double numbers. 
(d --- n ) Divides double-precision number (degrees of arc) by 
65 536 to give single number degrees with rounding. 

(ud1 u --- ude ) Returns ud1 right shifted u times. 

Set of words to print the corresponding day of the week. 


(d --- f) Leaves a true flag if the double number ts negative. 

(d --- f ) Leaves a true flag if the double number 1s zero. 

(ud! == ud2 ) Performs a 32-bit arithmetic shift left. 

(d1 2 --- f ) Leaves a true flag if the sop item is greater than the 
one under tt. 

(d1 d2 --- f ) Leaves a true flag if the double numbers are equal. 
(di d2 --- f ) Leaves a true flag if the top double item is less than 


. the double number under it. 


A defining word to return the month number and number of days 
in that month for use by DAYOWEEK. 

(n --- ) Prints the day of the week from the day number. 

Prints the day of the week given the day, name of the month and 
full year. 

(d --- n ) Returns cosine (scaled by 10000) of degrees x 65536. 
Adds a fixed offset to a 6522 Versatile Interface Adapter chip 
base address to leave the Data Direction Register A address. 

As DDRA but for the Data Direction Register B. 

(--- n ) Returns the number of items on the stack. 

(u --- d ) Returns factorial of u as a double- precision number. 
(d1 d2 --- d3 ) Leaves maximum of two double numbers. 

(d1d2 --- d3 ) Leaves minimum of two double numbers. 

(1 --- n2 ) Leaves factorial of n1. 

(d --- n) Leaves the square root of double number <. 

(ud1 ud2 --- f ) Leaves a true flag if the top unsigned double 
number is greater than the unsigned double number under it. 
(n1n2 --- ) Outputs n1/n2 as an Eygptian fraction. 

( addr --- t ) Enters numeric input to address leaving false flag if 
number in current base ts invalid. 

(addr 1 addr 2 --- ) Exchanges the bytes at addresses piven. 

1. Exitimmediately from the current definition. 


EXIT 
EXP 


FACT 
FACTORS 
FALSE 
FLAGS 
FP/. 
FREE 
FRESH 
GETDEGS 
HC F 
HEADER 
HISTORY 
l' 

IER 


LFR 
INFO 


INIT 
J 
JULIAN 


KN 


LAST 
LAT 
LCM 


LEN 
LENGTH 
LIMITS 
LOG2.N 
LONG 
LOWER 
Me / 


Me 
M/MOD 
MATRIX 
MIODLE 


MINSOUT 
MODULUS 
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2. Stop compilation of current screen. 
(n1 --- n2 ) Returns the exponential (scaled by 10000) of n1 for 
the range +1 (also scaled by 10000). 


(ul --- u2 ) Returns the factorial of u1. 
(n --- ) Prints out the factors of n. 
(--- ff ) Aconstant representing the false flag. 


A table of flags used by SIEVE. 

(ni n2 --- ) Outputs n1/n2 as a floating point string. 

(--- ) Outputs the available dictionary space. 

(--- ) Initializes the WkKSPC buffer used by FP/. 

Arranges stack contents for LAT and LONG. 

(ni n2 --- 13 ) Leaves the Highest Common Factor of ni and n2. 
Prints the header for a calendar. 

(--- addr ) Returns the address of the storage area used by C°' 
(--- n) Returns DO/LOOP end limit. 

Adds a fixed offset to a 6522 VIA chip base address to leave the 
Interrupt Enable Register address. 

As IER but for the Interrupt Flag Register address. 

(<name> --- ) Returns address and contents of the nfa, pfa and 
cfa of the named word. 

(--- ) Used by MULT to initialize the RESULT buffer. 

(--- n) Returns outer loop variable. 

(day month year --- d ) Leaves the Julian date as a 

double- precision number. 

(nt n2 --- 13) Acommon term used in series evaluation for SIN 
and (0S. 

A variable used by FACT. 

(0d --- ) Displays degrees (times 65 536) formatted as latitude. 
(nj n2 --- d ) Leaves Lowest Common Multiple as 
double-precision number. 

( addr --- n ) Leaves the length of the string at address. 

A constant used by (!! 

(ni lo hi --- n2) Limits n1 to within the limits of lo-hi. 

(ni --- n2 ) Returns the bit number of the lowest bit set. 

(d --- ) Displays degrees (65 536) formatted as longitude. 

A variable used by the binary search routine SEEK. 

(d1n1n2 --- d2 ) Leaves a double-precision number which is 
the result of multiplying a double number by the ratio n1/n2. 
(d1n--- d2 ) Leaves the double-precision sum of a 
single-precision number and a double-precision number. 

(ud1 u! --- u2 ud2 ) Divides unsigned double- precision number 
by unsigned single-precision number leaving an unsigned 
reminder with a double-precision quotient. 

A defining word that creates a table of 2-byte elements. 

A variable used by the quick sort routine SORT. 

Formats minutes of arc for LAT and LONG, 

(n1 ne --- n3 ) Leaves the square root of the sum of the squares 
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MODVAR 
MULT 


MYSELF 
N! 

N. FACTS 
NDUP 
NM2DEG 
NM> 

ORA 


ORB 

PCR 
PICK 
PLIST 
PROMPT 
PRIMES 
PRINT 
PRODUCT 
QUOT 
RANGE 


REMAIN 


RESULT 
RLOAD 
ROLL 
ROUND 
RP a) 
RVS 


SEEK 


SETUP 
SGN 
SIEVE 


SIN 


SIZE 
SIZE 
SORT 
SQRT 
SR 


SUM 


of ni andn2. 

A defining word to constrain a number within defined limits. 
(--- ) Outputs the product of two numbers input from the 
keyboard. 

(--- ) Compiles the cfa of the current definition. 

(n1 --- n2 ) Returns the factorial of n1. 

(n --- ) Computes and displays all factorials up to factonal n. 
Replicates the top N stack items. 

(n --- d ) Converts nautical miles to degrees latitude. 

(d --- n ) Converts degrees X 65 536 to nautical miles. 

Adds a fixed offset to a 6522 Versatile Interface Chip base 
address to leave the Output Register A address. 

As ORA, but for the Output Register B. 

As ORA, but for the Peripheral Control! Register. 

Picks the Nth stack item and puts a copy on the top. 

(scr --- ) Prints two screens side by side. 

Prompts for two numbers for MULT. 

(--- ) Generates prime numbers. 

An internal definition used by FACTORS to print the results. 

(n --- ) Leaves in *QUFF the value in 1BUFF multiplied by n. 
(ni n2 --- ) Used by FP/. to output the whole number quotient. 
Returns the range in nautical miles from the latitudes and 
longitudes of two points. 

(n1 n2 --- ) Used by FP/. to output the next digit of the 
remainder. 

An array used by MULT to accumulate the result. 

Loads a screen relative to the current value in BLK 

(n --- ) Rotates the top N stack items. 

(ni --- n2 ) Leaves ni rounded to nearest 10. 

(--- n ) Returns the current value of the return stack pointer. 
( --- ) An example to reverse the video of a 2K 
memory-mapped display system. 

(ni n2 3 --- n4 f ) Searches for n1 between n2 and n3 and 
returns index ton! and tme flag if found. 

(--- ) Sets up the factorial buffer for FACT. 

(ni --- n2 ) Returns the sign of n1, or 0 if zero. 

(---) A sieve to filter out numbers with factors used in 
conjunction with PRIMES. 

(ni --- n2 ) Returns sine (scaled by 10000) of angle n1 which, 
depending on definition used, may be 1n degrees or radians. 
1. A constant used by PRIMES. 

2, Aconstant used by FACT. 

(ni n2 --- ) Sorts an array of bytes from address n1 to nd. 

(ni --- n2 ) Returns the square root of n1. 

Adds a fixed offset for 6522 VIA Shift Register base address to 
leave the Shift Register address. 

(n --- ) Used by MULT to add the partial product. Adds the 


UM/ 


UPPER 
VSWAP 
WEEK’ 


WITHIN 
WK SPC 
XS 
(cos) 
Cocos] 
\ 
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content of *BUFF offset byn to accumulate in RESULT buffer. 
Adds a fixed offset for 6522 VIA Timer 1 Counter register High 
byte address. 

As T1C-H but for Low byte. 

As T1C-H but for Latch register High byte address. 

As T1C-H but for Latch register Low byte address. 

As T1C-H but for Timer 2 Counter High byte address. 

As T1C-H but for Timer 2 Counter Low byte address. 

A defining word to create a table of bytes. 

Loads a range of screens. 

(--- ) Used by MULT to multiply the contents of 1BUFF and 2BUFF. 
An internal definition used by FACTORS to apply trial divisors. 

A table of primes numbers used by FACTORS. 

(--- tf ) A constant representing the value of the true flag. 

(n lo hi --- f ) Returns true flag ifn is twixt low and high. 

(u --- ) Prints the top stack item as an unsigned number. 
(un---)asU. but with a field- width of n. 

(ud n --- ) Prints as unsigned the double number ud in a 

field- width of n. 

(d1u --- d2 ) Leaves a double number which is the product of a 
double- precision and a single- precision number. 

(d1u --- d2 ) Leaves a double number which is the quotient of a 
double-precision and a single- precision number. 

A variable used by the binary search routine SEEK. 

(addr1 addr2 --- ) Swaps the address contents. 

(n1 --- n2 ) Formats one week for CALENDAR if ni is in range of 
permissible dates. 

(lo hi n--- f ) tests for N within the limits lo—hi. 

(--- addr) Returns the address of a Workspace for use by FP/. 
A variable used for storing X-squared in evaluating a senes. 

As for C0S but for 0 to +90 degrees. 

As for COS but for 0 to +90 degrees in X 65 536 format. 
Suspend compilation until next line. Pronounced ‘skip line’. 
Generally used to start a comment field. 
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Forth: 
The NEXT Step 


Ron Geere 


Forth the lanquage of the International Astronomical Union. is 
rapidl\ establishing itself as an important applications 
programming lanquage in the professional field. particularly 
forcontrol applications such as process control and robotics. 
Apart from its adaptability toa number of diverse applications, 
Forth has the advantage of being highly portable from one 
machine to another. In this book. the author concentrates on 
the two dominant standards of the lanquage. FiqForth and ‘79 - 
standard, though the recent ‘83 - standard and other variants 
are also considered. 


Forth. like aliving lanquage, isextensible. New words canbe 
defined to suit the particular purpose of the user. Inthis book 
the author presents some commonextensions tothe minimum 
required word set along with some programs that have been 
found to be either useful or entertaining. These will stimulate 
users to discover solutions to theirown programming 
problems. In particular, solutions are provided to problems not 
readily realized in integer mathematics. 


This book will be of interest to the qrowing body of Forth 
enthusiasts who, having learned the fundamentals of the 
lanquage, wish to take the next step - especially scientists. 
engineers and computing professionals who are looking for 
tools’ to doa particular job. The approach throughout ts 
practical, with anemphasis on using the lanquage. 


Among the useful topics covered are: 
* Formatting 

* Calendar functions 

* Double-number definitions 

* Mathematical functions 


Additionally, a wide range of general purpose and frequently 
used definitions and tools are included. A glossary and 
bibliography complete this compact and useful reference text. 
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